home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Applications / NIH Image 1.59 / 1.59 Source / Utilities.p < prev   
Encoding:
Text File  |  1995-10-23  |  80.0 KB  |  3,362 lines  |  [TEXT/PJMM]
  1. unit Utilities;
  2.  
  3. {Miscellaneous utility routines used by NIH Image}
  4.  
  5. interface
  6.  
  7.    uses
  8.         Memory, QuickDraw, Packages, Devices, Menus, Events, Fonts, Scrap, TextEdit, ToolUtils, Dialogs,
  9.         Controls, Palettes, ColorPicker, Printing, SegLoad, Processes, QuickTimeComponents, globals;
  10.  
  11.  
  12.  
  13.     procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
  14.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  15.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  16.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  17.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  18.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  19.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  20.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  21.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  22.     function StringToReal (str: str255): extended;
  23.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  24.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  25.     procedure DrawReal (Val: extended; width, fwidth: integer);
  26.     procedure DrawJReal (hloc, vloc: integer; Val: extended; fwidth: integer);
  27.     procedure DrawLong (i: LongInt);
  28.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  29.     function GetReal (message: str255; default: extended; precision: integer; var Canceled: boolean): extended;
  30.     function OptionKeyDown: boolean;
  31.     function ShiftKeyDown: boolean;
  32.     function ControlKeyDown: boolean;
  33.     function CommandPeriod: boolean;
  34.     function SpaceBarDown: boolean;
  35.  
  36.     procedure SysResume;
  37.     procedure beep;
  38.     procedure PutMessage (str: str255);
  39.     procedure PutError (str: str255);
  40.     procedure UnprotectLUT;
  41.     procedure LoadLUT (table: MyCSpecArray);
  42.     procedure SetupLutUndo;
  43.     procedure UndoLutChange;
  44.     procedure DisableDensitySlice;
  45.     procedure LoadInputLUT (address: ptr);
  46.     procedure ResetQuickCapture;
  47.     procedure ResetScionLG3;
  48.     procedure ResetScionAG5;
  49.     procedure ResetScionVG5f;
  50.     procedure ResetFrameGrabber;
  51.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  52.     procedure wait (ticks: LongInt);
  53.     function GetScrapCount: integer;
  54.     procedure DisplayText (update: boolean);
  55.     procedure ScreenToOffscreen (var loc: point);
  56.     procedure OffscreenToScreen (var loc: point);
  57.     procedure OffScreenToScreenRect (var r: rect);
  58.     procedure UpdateScreen (MaskRect: rect);
  59.     procedure RestoreRoi;
  60.     procedure Undo;
  61.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  62.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  63.     function GetFontSize (item: integer): integer;
  64.     function MyGetPixel (h, v: LongInt): integer;
  65.     procedure PutPixel (h, v: LongInt; value: integer);
  66.     procedure GetLine (h, v, count: LongInt; var line: LineType);
  67.     procedure GetColumn (h, v, count: LongInt; var data: LineType);
  68.     procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
  69.     procedure PutLine (h, v, count: LongInt; var line: LineType);
  70.     procedure Show1Value (rvalue, CalibratedValue: extended);
  71.     procedure Show2PlotValues (x, y: extended);
  72.     procedure Show2Values (current, total: LongInt);
  73.     procedure DrawXDimension (x: extended; digits: integer);
  74.     procedure DrawYDimension (y: extended; digits: integer);
  75.     procedure DrawRGB (index: integer);
  76.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  77.     procedure ShowDxDy (X, Y: extended);
  78.     procedure PutChar (c: char);
  79.     procedure PutTab;
  80.     procedure PutString (str: str255);
  81.     procedure PutReal (n: extended; width, fwidth: integer);
  82.     procedure PutLong (n: LongInt; FieldWidth: integer);
  83.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  84.     procedure ShowWatch;
  85.     procedure ShowAnimatedWatch;
  86.     procedure UpdatePicWindow;
  87.     procedure DoOperation (Operation: OpType);
  88.     procedure SaveRoi;
  89.     procedure KillRoi;
  90.     procedure ShowRoi;
  91.     procedure SetupUndo;
  92.     procedure SetupUndoFromClip;
  93.     procedure GetLoi (var x1, y1, x2, y2: extended);
  94.     function NotRectangular: boolean;
  95.     function NotInBounds: boolean;
  96.     function NoSelection: boolean;
  97.     function NoUndo: boolean;
  98.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  99.     function NewPicWindow (name: str255; width, height: integer): boolean;
  100.     function GetAngle (dx, dy: extended):extended;
  101.     procedure MakeRegion;
  102.     procedure SelectAll (visible: boolean);
  103.     procedure EraseScreen;
  104.     procedure RestoreScreen;
  105.     procedure UpdateTitleBar;
  106.     procedure Unzoom;
  107.     procedure DrawBString (str: string);
  108.     procedure DrawMyGrowIcon (w: WindowPtr);
  109.     procedure PutMemoryAlert;
  110.     function GetBigHandle (NeededSize: LongInt): handle;
  111.     function GetImageMemory (SaveInfo: infoPtr): ptr;
  112.     procedure UpdateAnalysisMenu;
  113.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  114.     procedure MakeNewWindow (name: str255);
  115.     function long2str (num: LongInt): str255;
  116.     procedure PutWarning;
  117.     procedure ScaleToFit;
  118.     procedure SetupRoiRect;
  119.     procedure SetForegroundColor (color: integer);
  120.     procedure SetBackgroundColor (color: integer);
  121.     procedure GetForegroundColor (event: EventRecord);
  122.     procedure GetBackgroundColor (event: EventRecord);
  123.     procedure GenerateValues;
  124.     procedure KillOperation;
  125.     procedure ScaleImageWindow (var trect: rect);
  126.     procedure InvertGrayLevels;
  127.     function TooWide: boolean;
  128.     procedure DrawTextString (str: str255; loc: point; just: integer);
  129.     procedure IncrementCounter;
  130.     procedure ClearResults (i: integer);
  131.     procedure UpdateFitEllipse;
  132.     procedure UpdateTextItems;
  133.     procedure MakeLowerCase (var str: str255);
  134.     function PutMessageWithCancel (str: str255): integer;
  135.     function CurrentWindow: integer;
  136.     procedure FindMonitors (NewScreenDepth: integer);
  137.     function ScreenDepth: integer;
  138.     procedure SetFColor (index: integer);
  139.     procedure SetBColor (index: integer);
  140.     function DoubleToReal(d:FakeDouble):extended; {68k-bug}
  141.     procedure RealToDouble(rr: extended; var d:FakeDouble);
  142.     function MakeStackFromWindow: boolean;
  143.     procedure SelectSlice (i: integer);
  144.     procedure UpdateWindowsMenuItem;
  145.     function AddSlice (update: boolean): boolean;
  146.     procedure AbortMacro;
  147.     procedure TruncateString(var str: str255; length: integer);
  148.     procedure RemovePath(var str: str255);
  149.     procedure CloseVdig;
  150.     
  151.  
  152. implementation
  153.  
  154.  
  155.     type
  156.         KeyPtrType = ^KeyMap;
  157.  
  158.  
  159.  
  160.     {procedure MacsBug (str: str255);
  161.     inline
  162.         $abff;}
  163.  
  164.  
  165.     procedure ShowMessage (str: str255);
  166.         var
  167.             vloc, hloc: integer;
  168.             tPort: GrafPtr;
  169.             trect: rect;
  170.             SaveGDevice: GDHandle;
  171.     begin
  172.         SaveGDevice := GetGDevice;
  173.         SetGDevice(GetMainDevice);
  174.       InfoMessage := str;
  175.         GetPort(tPort);
  176.         vloc := 35;
  177.         hloc := 4;
  178.         SetPort(InfoWindow);
  179.         TextFont(Geneva);
  180.         TextSize(9);
  181.         Setrect(trect, hloc, vloc + 15, rwidth - 10, rheight);
  182.         TETextBox(pointer(ord(@InfoMessage) + 1), length(InfoMessage), trect, teJustLeft);
  183.         SetPort(tPort);
  184.         SetGDevice(SaveGDevice);
  185.         wait(120);
  186.     end;
  187.  
  188.  
  189.     procedure SetDlogItem (TheDialog: DialogPtr; item, value: integer);
  190.         var
  191.             ItemType: integer;
  192.             ItemBox: rect;
  193.             ItemHdl: handle;
  194.     begin
  195.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  196.         SetControlValue(ControlHandle(ItemHdl),value)
  197.     end;
  198.  
  199.  
  200.     procedure OutlineButton (theDialog: DialogPtr; itemNo, CornerRad: integer);
  201.   {Draws a border around a button. 16 is the normal}
  202.   {corner radius for small buttons }
  203.         var
  204.             itemType: Integer;
  205.             itemBox: Rect;
  206.             itemHdl: Handle;
  207.             tempPort: GrafPtr;
  208.     begin
  209.         GetPort(tempPort);
  210.         SetPort(GrafPtr(theDialog));
  211.         GetDialogItem(theDialog, itemNo, itemType, itemHdl, itemBox);
  212.         PenSize(3, 3);
  213.         InSetRect(itemBox, -4, -4);
  214.         FrameRoundRect(itemBox, cornerRad, cornerRad);
  215.         PenSize(1, 1);
  216.         SetPort(tempPort);
  217.     end;
  218.  
  219.  
  220.     function GetDNum (TheDialog: DialogPtr; item: integer): LongInt;
  221.         var
  222.             ItemType: integer;
  223.             ItemBox: rect;
  224.             ItemHdl: handle;
  225.             str: str255;
  226.             n: LongInt;
  227.     begin
  228.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  229.         GetDialogItemText(ItemHdl, str);
  230.         StringToNum(str, n);
  231.         GetDNum := n;
  232.     end;
  233.  
  234.  
  235.     function GetDString (TheDialog: DialogPtr; item: integer): str255;
  236.         var
  237.             ItemType: integer;
  238.             ItemBox: rect;
  239.             ItemHdl: handle;
  240.             str: str255;
  241.     begin
  242.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  243.         GetDialogItemText(ItemHdl, str);
  244.         GetDString := str;
  245.     end;
  246.  
  247.  
  248.     procedure SetDNum (TheDialog: DialogPtr; item: integer; n: LongInt);
  249.         var
  250.             ItemType: integer;
  251.             ItemBox: rect;
  252.             ItemHdl: handle;
  253.             str: str255;
  254.     begin
  255.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  256.         NumToString(n, str);
  257.         SetDialogItemText(ItemHdl, str)
  258.     end;
  259.  
  260.  
  261.     procedure GetWindowRect (w: WindowPtr; var wrect: rect);
  262.   {Returns global coordinates of specified window.}
  263.     begin
  264.         if w <> nil then
  265.             wrect := WindowPeek(w)^.contRgn^^.rgnBBox
  266.         else
  267.             SetRect(wrect, 0, 0, 0, 0);
  268.     end;
  269.  
  270.  
  271.     procedure SetDReal (TheDialog: DialogPtr; item: integer; n: extended; fwidth: integer);
  272.         var
  273.             ItemType: integer;
  274.             ItemBox: rect;
  275.             ItemHdl: handle;
  276.             str: str255;
  277.     begin
  278.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  279.         RealToString(n, 1, fwidth, str);
  280.         SetDialogItemText(ItemHdl, str)
  281.     end;
  282.  
  283.     procedure SetDString (TheDialog: DialogPtr; item: integer; str: str255);
  284.         var
  285.             ItemType: integer;
  286.             ItemBox: rect;
  287.             ItemHdl: handle;
  288.     begin
  289.         GetDialogItem(TheDialog, item, ItemType, ItemHdl, ItemBox);
  290.         SetDialogItemText(ItemHdl, str)
  291.     end;
  292.  
  293.  
  294.     function GetDReal (TheDialog: DialogPtr; item: integer): extended;
  295.         var
  296.             str: str255;
  297.     begin
  298.         str := GetDString(TheDialog, item);
  299.         GetDReal := StringToReal(str);
  300.     end;
  301.  
  302.  
  303.     procedure DrawLong (i: LongInt);
  304.         var
  305.             str: str255;
  306.     begin
  307.         NumToString(i, str);
  308.         DrawString(str);
  309.     end;
  310.  
  311.  
  312.     procedure RealToString (Val: extended; width, fwidth: integer; var Str: Str255);
  313.   {Does number to string conversion equivalent to write(val:width:fwidth).}
  314.   var
  315.       i:integer;
  316.     begin
  317.         if width<1 then width:=1;
  318.         if (fwidth<0) or (fwidth>8) then fwidth:=0;
  319.         str:=StringOf(val:width:fwidth);
  320.     end;
  321.  
  322.  
  323.     procedure DrawReal (Val: extended; width, fwidth: integer);
  324.   {Displays a real(or integer) number at the current location in}
  325.   {a form equivalent to write(val:width:fwidth) }
  326.         var
  327.             str: str255;
  328.     begin
  329.         RealToString(val, width, fwidth, str);
  330.         DrawString(str);
  331.     end;
  332.  
  333.  
  334.     procedure DrawJReal (hloc, vloc: integer; val: extended; fwidth: integer);
  335.   {Draws right justified real number.}
  336.         var
  337.             str: str255;
  338.     begin
  339.         if (val >= 1000.0) or (val <= -1000.0) then
  340.             fwidth := 0;
  341.         RealToString(val, 1, fwidth, str);
  342.         MoveTo(hloc - StringWidth(str) - 2, vloc);
  343.         DrawString(str);
  344.     end;
  345.  
  346.  
  347.     function GetInt (message: str255; default: integer; var Canceled: boolean): integer;
  348.         const
  349.             NumberID = 3;
  350.         var
  351.             mylog: DialogPtr;
  352.             item: integer;
  353.             temp: LongInt;
  354.     begin
  355.         ParamText(message, '', '', '');
  356.         mylog := GetNewDialog(3000, nil, pointer(-1));
  357.         SetDNum(MyLog, NumberID, default);
  358.         SelectdialogItemText(MyLog, NumberID, 0, 32767);
  359.         OutlineButton(MyLog, ok, 16);
  360.         repeat
  361.             ModalDialog(nil, item);
  362.         until (item = ok) or (item = cancel);
  363.         if item = ok then begin
  364.                 Canceled := false;
  365.                 temp := GetDNum(MyLog, NumberID);
  366.                 if (temp > -MaxInt) and (temp <= MaxInt) then
  367.                     GetInt := temp
  368.                 else begin
  369.                         beep;
  370.                         GetInt := default
  371.                     end;
  372.             end {item=ok}
  373.         else begin
  374.                 Canceled := true;
  375.                 GetInt := default;
  376.             end;
  377.         DisposeDialog(mylog);
  378.     end;
  379.  
  380.  
  381.     function GetReal (message: str255; default: extended; precision: integer; var Canceled: boolean): extended;
  382.         const
  383.             NumberID = 3;
  384.         var
  385.             mylog: DialogPtr;
  386.             item: integer;
  387.     begin
  388.         InitCursor;
  389.         ParamText(message, '', '', '');
  390.         mylog := GetNewDialog(3000, nil, pointer(-1));
  391.         SetDReal(MyLog, NumberID, default, precision);
  392.         SelectdialogItemText(MyLog, NumberID, 0, 32767);
  393.         OutlineButton(MyLog, ok, 16);
  394.         repeat
  395.             ModalDialog(nil, item);
  396.         until (item = ok) or (item = cancel);
  397.         if item = ok then begin
  398.                 GetReal := GetDReal(MyLog, NumberID);
  399.                 Canceled := false;
  400.             end
  401.         else begin
  402.                 GetReal := default;
  403.                 Canceled := true;
  404.             end;
  405.         DisposeDialog(mylog);
  406.     end;
  407.  
  408.  
  409.     function OptionKeyDown: boolean;
  410.         var
  411.             KeyPtr: KeyPtrType;
  412.             keys: array[0..3] of LongInt;
  413.     begin
  414.         KeyPtr := KeyPtrType(@keys);
  415.         GetKeys(KeyPtr^);
  416.         OptionKeyDown := (BAND(keys[1], 4)) <> 0;
  417.     end;
  418.  
  419.  
  420.     function ShiftKeyDown: boolean;
  421.         var
  422.             KeyPtr: KeyPtrType;
  423.             keys: array[0..3] of LongInt;
  424.     begin
  425.         KeyPtr := KeyPtrType(@keys);
  426.         GetKeys(KeyPtr^);
  427.         ShiftKeyDown := (BAND(keys[1], 1)) <> 0;
  428.     end;
  429.  
  430.  
  431.     function ControlKeyDown: boolean;
  432.         type
  433.             KeyPtrType = ^KeyMap;
  434.         var
  435.             KeyPtr: KeyPtrType;
  436.             keys: array[0..3] of LongInt;
  437.     begin
  438.         KeyPtr := KeyPtrType(@keys);
  439.         GetKeys(KeyPtr^);
  440.         ControlKeyDown := (BAND(keys[1], 8)) <> 0;
  441.     end;
  442.  
  443.  
  444.     function CommandPeriod: boolean;
  445.         type
  446.             KeyPtrType = ^KeyMap;
  447.         var
  448.             KeyPtr: KeyPtrType;
  449.             keys: array[0..3] of LongInt;
  450.     begin
  451.         KeyPtr := KeyPtrType(@keys);
  452.         GetKeys(KeyPtr^);
  453.         CommandPeriod := (BAND(keys[1], $808000)) = $808000;
  454.     end;
  455.  
  456.  
  457.     function SpaceBarDown: boolean;
  458.         var
  459.             KeyPtr: KeyPtrType;
  460.             keys: array[0..3] of LongInt;
  461.     begin
  462.         KeyPtr := KeyPtrType(@keys);
  463.         GetKeys(KeyPtr^);
  464.         SpaceBarDown := (BAND(keys[1], 512)) <> 0;
  465.     end;
  466.  
  467.  
  468.     procedure DrawSItem (itemnum, fontrqst, sizerqst: integer; d: dialogptr; s: str255);
  469.  {Draw a string item in a dialog box.}
  470.         var
  471.             r: rect;
  472.             iType: integer;
  473.             ignore: handle;
  474.     begin
  475.         GetDialogItem(d, ItemNum, iType, ignore, r);
  476.         TextFont(fontrqst);
  477.         TextSize(sizerqst);
  478.         TETextBox(pointer(ord(@s) + 1), length(s), r, TEJustRight);
  479.     end;
  480.  
  481.  
  482.     procedure SysResume;
  483.     begin
  484.         FlushEvents(EveryEvent, 0);
  485.         ExitToShell;
  486.     end;
  487.  
  488.  
  489.     procedure beep;
  490.     {Sets the current gdevice to the screen because SysBeep flashes
  491.   the menu bar if the sound level is zero and this is reported to sometimes
  492.     cause a crash on older Macs when using an offscreen gdevice.} 
  493.         var
  494.             SaveGDevice: GDHandle;
  495.     begin
  496.         SaveGDevice := GetGDevice;
  497.         SetGDevice(GetMainDevice);
  498.         SysBeep(1);
  499.         SetGDevice(SaveGDevice);
  500.     end;
  501.  
  502.  
  503.     procedure PutMessage (str: str255);
  504.         var
  505.             ignore: integer;
  506.             SaveGDevice: GDHandle;
  507.     begin
  508.         SaveGDevice := GetGDevice;
  509.         SetGDevice(GetMainDevice);
  510.         InitCursor;
  511.         ParamText(str, '', '', '');
  512.         Ignore := Alert(300, nil);
  513.         SetGDevice(SaveGDevice);
  514.     end;
  515.     
  516.  
  517.     procedure PutError (str: str255);
  518.         var
  519.             ignore: integer;
  520.             SaveGDevice: GDHandle;
  521.     begin
  522.         SaveGDevice := GetGDevice;
  523.         SetGDevice(GetMainDevice);
  524.         InitCursor;
  525.         ParamText(str, '', '', '');
  526.         Ignore := Alert(310, nil);
  527.         SetGDevice(SaveGDevice);
  528.     end;
  529.  
  530.  
  531.     function GetFontSize (item: integer): integer;
  532.         var
  533.             TempSize: integer;
  534.             Canceled: boolean;
  535.     begin
  536.         case item of
  537.             1: 
  538.                 GetFontSize := 9;
  539.             2: 
  540.                 GetFontSize := 10;
  541.             3: 
  542.                 GetFontSize := 12;
  543.             4: 
  544.                 GetFontSize := 14;
  545.             5: 
  546.                 GetFontSize := 18;
  547.             6: 
  548.                 GetFontSize := 24;
  549.             7: 
  550.                 GetFontSize := 36;
  551.             8: 
  552.                 GetFontSize := 48;
  553.             9: 
  554.                 GetFontSize := 56;
  555.             10: 
  556.                 GetFontSize := 72;
  557.             12:  begin
  558.                     TempSize := GetInt('Font Size:', CurrentSize, Canceled);
  559.                     if TempSize < 1 then
  560.                         TempSize := 1;
  561.                     if TempSize > 1000 then
  562.                         TempSize := 1000;
  563.                     if not canceled then
  564.                         GetFontSize := TempSize
  565.                     else
  566.                         GetFontSize := CurrentSize;
  567.                 end;
  568.         end;
  569.     end;
  570.  
  571.  
  572.     procedure SetMenuItem (menuh: menuhandle; itemnum: integer; on: boolean);
  573. {Enable or disable menuh's itemnum. }
  574.     begin
  575.         if on then
  576.             EnableItem(menuh, itemnum)
  577.         else
  578.             DisableItem(menuh, itemnum);
  579.         if ItemNum = 0 then
  580.             DrawMenuBar;
  581.     end;
  582.  
  583.  
  584.     procedure CheckOnOffItem (MenuH: MenuHandle; item, fst, lst: Integer);
  585.         var
  586.             i: integer;
  587.     begin
  588.         for i := fst to lst do
  589.             if i = item then
  590.                 CheckItem(MenuH, i, true)
  591.             else
  592.                 CheckItem(MenuH, i, false);
  593.     end;
  594.  
  595.  
  596.     procedure UpdateTextItems;
  597.         var
  598.             size, i, MenuItem, FontID, item: integer;
  599.             FontName: str255;
  600.             FontFound, FoundIt: boolean;
  601.             str: str255;
  602.     begin
  603.         FontFound := false;
  604.         for item := 1 to NumFontItems do begin
  605.                 GetMenuItemText(FontMenuH, Item, FontName);
  606.                 GetFNum(FontName, FontID);
  607.                 if FontID = CurrentFontID then begin
  608.                         FontFound := true;
  609.                         CheckItem(FontMenuH, Item, True)
  610.                     end
  611.                 else
  612.                     CheckItem(FontMenuH, Item, false);
  613.             end;
  614.         if not FontFound then begin
  615.                 FoundIt := False;
  616.                 Item := 1;
  617.                 repeat
  618.                     GetMenuItemText(FontMenuH, Item, FontName);
  619.                     GetFNum(FontName, FontID);
  620.                     if FontID = Geneva then begin
  621.                             CheckItem(FontMenuH, Item, True);
  622.                             CurrentFontID := FontID;
  623.                             FoundIt := true;
  624.                         end;
  625.                     Item := Item + 1;
  626.                 until (Item > NumFontItems) or FoundIt;
  627.             end;
  628.  
  629.         for i := 1 to 10 do begin
  630.                 size := GetFontSize(i);
  631.                 if RealFont(CurrentFontID, size) then
  632.                     SetItemStyle(SizeMenuH, i, [outline])
  633.                 else
  634.                     SetItemStyle(SizeMenuH, i, [])
  635.             end;
  636.         NumToString(CurrentSize, str);
  637.         str := concat('Other[', str, ']…');
  638.         SetMenuItemText(SizeMenuH, 12, str);
  639.  
  640.         for i := TxPlain to TxShadow do
  641.             CheckItem(StyleMenuH, i, false);
  642.         if CurrentStyle = [] then
  643.             CheckItem(StyleMenuH, TxPlain, true)
  644.         else begin
  645.                 if Bold in CurrentStyle then
  646.                     CheckItem(StyleMenuH, TxBold, true);
  647.                 if Italic in CurrentStyle then
  648.                     CheckItem(StyleMenuH, TxItalic, true);
  649.                 if Underline in CurrentStyle then
  650.                     CheckItem(StyleMenuH, TxUnderline, true);
  651.                 if Outline in CurrentStyle then
  652.                     CheckItem(StyleMenuH, TxOutline, true);
  653.                 if Shadow in CurrentStyle then
  654.                     CheckItem(StyleMenuH, Txshadow, true);
  655.             end;
  656.  
  657.         case CurrentSize of
  658.             9: 
  659.                 MenuItem := 1;
  660.             10: 
  661.                 MenuItem := 2;
  662.             12: 
  663.                 MenuItem := 3;
  664.             14: 
  665.                 MenuItem := 4;
  666.             18: 
  667.                 MenuItem := 5;
  668.             24: 
  669.                 MenuItem := 6;
  670.             36: 
  671.                 MenuItem := 7;
  672.             48: 
  673.                 MenuItem := 8;
  674.             56: 
  675.                 MenuItem := 9;
  676.             72: 
  677.                 MenuItem := 10;
  678.             otherwise
  679.                 MenuItem := 12;
  680.         end;
  681.         CheckOnOffItem(SizeMenuH, MenuItem, 1, 12);
  682.  
  683.         case TextJust of
  684.             teJustLeft: 
  685.                 MenuItem := LeftItem;
  686.             teJustCenter: 
  687.                 MenuItem := CenterItem;
  688.             teJustRight: 
  689.                 MenuItem := RightItem;
  690.         end;
  691.         CheckOnOffItem(StyleMenuH, MenuItem, LeftItem, RightItem);
  692.  
  693.         if TextBack = NoBack then
  694.             MenuItem := NoBackgroundItem
  695.         else
  696.             MenuItem := WithBackgroundItem;
  697.         CheckOnOffItem(StyleMenuH, MenuItem, NoBackgroundItem, WithBackgroundItem);
  698.     end;
  699.  
  700.  
  701.     procedure LoadLUT (table: MyCSpecArray);
  702.         var
  703.             i, entry, screen: integer;
  704.             cPtr: ^cSpecArray;
  705.             SaveDevice: GDHandle;
  706.     begin
  707.         if nExtraColors > 0 then begin
  708.                 entry := FirstExtraColorsEntry;
  709.                 for i := 1 to nExtraColors do begin
  710.                         table[entry].rgb := ExtraColors[i];
  711.                         entry := entry + 1;
  712.                     end;
  713.             end;
  714.         if HighLightMode then begin
  715.                 table[1].rgb := Highlight1;
  716.                 table[254].rgb := Highlight254;
  717.             end;
  718.         for i := 1 to 254 do {Work around needed for 32-bit QuickDraw}
  719.             with table[i].rgb do
  720.                 if (red = 0) and (green = 0) and (blue = 0) then begin
  721.                         red := 256;
  722.                         green := 256;
  723.                         blue := 256;
  724.                     end;
  725.         cPtr := @table[1];
  726.         SaveDevice := GetGDevice;
  727.         for screen := 1 to nMonitors do begin
  728.                 SetGDevice(Monitors[screen]);
  729.                 for i := 1 to 254 do begin
  730.                         ProtectEntry(i, false);
  731.                         ReserveEntry(i, false);
  732.                     end;
  733.                 SetEntries(1, 253, cPtr^);
  734.             end;
  735.         SetGDevice(SaveDevice);
  736.         table[0].rgb := WhiteRGB;
  737.         table[255].rgb := BlackRGB;
  738.         BlockMove(@table, @osGDevice^^.gdPMap^^.pmTable^^.ctTable, SizeOf(table));
  739.         with osGDevice^^.gdPMap^^.pmTable^^ do
  740.             if ScreenDepth = 8 then
  741.                 ctSeed := ScreenPixMap^^.pmTable^^.ctSeed
  742.             else
  743.                 ctSeed := GetCtSeed;
  744.     end;
  745.  
  746.  
  747.     procedure SetupLutUndo;
  748.     begin
  749.         with info^ do begin
  750.                 UndoInfo^.RedLut := RedLut;
  751.                 UndoInfo^.GreenLut := GreenLut;
  752.                 UndoInfo^.BlueLut := BlueLut;
  753.                 UndoInfo^.nColors := nColors;
  754.                 UndoInfo^.ColorStart := ColorStart;
  755.                 UndoInfo^.ColorEnd := ColorEnd;
  756.                 UndoInfo^.FillColor1 := FillColor1;
  757.                 UndoInfo^.FillColor2 := FillColor2;
  758.                 UndoInfo^.LutMode := LutMode;
  759.                 UndoInfo^.ColorTable := ColorTable;
  760.                 UndoInfo^.IdentityFunction := IdentityFunction;
  761.                 UndoInfo^.cTable := cTable;
  762.                 WhatToUndo := UndoLUT;
  763.             end;
  764.     end;
  765.  
  766.  
  767.     procedure UndoLutChange;
  768.     begin
  769.         with info^ do begin
  770.                 RedLut := UndoInfo^.RedLut;
  771.                 GreenLut := UndoInfo^.GreenLut;
  772.                 BlueLut := UndoInfo^.BlueLut;
  773.                 nColors := UndoInfo^.nColors;
  774.                 ColorStart := UndoInfo^.ColorStart;
  775.                 ColorEnd := UndoInfo^.ColorEnd;
  776.                 FillColor1 := UndoInfo^.FillColor1;
  777.                 FillColor2 := UndoInfo^.FillColor2;
  778.                 LutMode := UndoInfo^.LutMode;
  779.                 LutMode := UndoInfo^.LutMode;
  780.                 ColorTable := UndoInfo^.ColorTable;
  781.                 cTable := UndoInfo^.cTable;
  782.                 LoadLut(cTable);
  783.                 Thresholding := false;
  784.                 WhatToUndo := NothingToUndo;
  785.             end;
  786.     end;
  787.  
  788.  
  789.     procedure UpdatePicWindow;
  790.         var
  791.             tPort: GrafPtr;
  792.             SaveGDevice: GDHandle;
  793.     begin
  794.         if (info <> NoInfo) and (info^.wptr <> nil) then
  795.             with Info^ do begin
  796.                     SaveGDevice := GetGDevice;
  797.                     SetGDevice(GetMainDevice);
  798.                     getPort(tPort);
  799.                     SetPort(wptr);
  800.                     SetFColor(BlackIndex);
  801.                     SetBColor(WhiteIndex);
  802.                     CopyBits(BitMapHandle(osPort^.portPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, nil);
  803.                     SetPort(tPort);
  804.                     SetGDevice(SaveGDevice);
  805.                     RoiUpdateTime := 0;
  806.                 end;
  807.     end;
  808.  
  809.  
  810.     procedure DisableDensitySlice;
  811.         var
  812.             tPort: GrafPtr;
  813.     begin
  814.         if DensitySlicing then begin
  815.                 DensitySlicing := false;
  816.                 UndoLutChange;
  817.                 if ScreenDepth <> 8 then begin
  818.                         UpdatePicWindow;
  819.                         GetPort(tPort);
  820.                         SetPort(LUTWindow);
  821.                         InvalRect(LutWindow^.PortRect);
  822.                         SetPort(tPort);
  823.                     end;
  824.             end;
  825.     end;
  826.  
  827.  
  828.     procedure LoadInputLUT (address: ptr);
  829.         type
  830.             ilutType = packed array[0..1023] of byte;
  831.             ilutPtr = ^ilutType;
  832.         var
  833.             ilut: ilutPtr;
  834.             i: integer;
  835.     begin
  836.         ilut := ilutPtr(address);
  837.         if InvertVideo then begin
  838.                 for i := 0 to 255 do
  839.                     ilut^[i * 4] := i;
  840.                 ilut^[0] := 1;
  841.                 ilut^[255 * 4] := 254
  842.             end
  843.         else begin
  844.                 for i := 0 to 255 do
  845.                     ilut^[i * 4] := 255 - i;
  846.                 ilut^[0] := 254;
  847.                 ilut^[255 * 4] := 1
  848.             end;
  849.     end;
  850.  
  851.  
  852.     procedure ResetQuickCapture;
  853.         const
  854.             ilutOffset = $90000;
  855.     begin
  856.         ControlReg^ := 1; {reset}
  857.         while BitAnd(ControlReg^, $80) = $80 do
  858.             ;
  859.         ChannelReg^ := VideoChannel * 64;
  860.         while BitAnd(ControlReg^, $80) = $80 do
  861.             ;
  862.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  863.     end;
  864.  
  865.  
  866.     procedure ResetScionLG3;
  867.         const
  868.             ilutOffset = $80000;
  869.         var
  870.             SyncChannel, t: integer;
  871.     begin
  872.         ControlReg^ := 0;
  873.         BufferReg^ := 0;
  874.         if SyncMode = SeparateSync then
  875.             SyncChannel := 3
  876.         else
  877.             SyncChannel := VideoChannel;
  878.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  879.         ChannelReg^ := bor(LG3DataOut, bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  880.         DacHighReg^ := DacHigh;
  881.         DacLowReg^ := DacLow;
  882.         DacAReg^ := LG3DacA;
  883.         DacBReg^ := LG3DacB;
  884.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  885.     end;
  886.  
  887.  
  888.     procedure ResetScionAG5;
  889.         const
  890.             ilutOffset = $E0000;
  891.         var
  892.             SyncChannel: integer;
  893.     begin
  894.         ControlReg^ := 0;
  895.         if SyncMode = SeparateSync then
  896.             SyncChannel := 3
  897.         else
  898.             SyncChannel := VideoChannel;
  899.         ChannelReg^ := bor(ord(AG5BufferMode), bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6)));
  900.         DacHighReg^ := DacHigh;
  901.         DacLowReg^ := DacLow;
  902.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  903.     end;
  904.  
  905.  
  906.     procedure ResetScionVG5f;
  907.         const
  908.             ilutOffset = $80000;
  909.         var
  910.             SyncChannel, t: integer;
  911.     begin
  912.         ControlReg^ := 0;
  913.         if SyncMode = SeparateSync then
  914.             SyncChannel := 3
  915.         else
  916.             SyncChannel := VideoChannel;
  917.         t := band(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  918.         ChannelReg^ := bor(bsl(VideoChannel, 4), bsl(SyncChannel, 6));
  919.         DacHighReg^ := DacHigh;
  920.         DacLowReg^ := DacLow;
  921.         LoadInputLUT(Ptr(fgSlotBase + ilutOffset));
  922.     end;
  923.  
  924.  
  925.     procedure ResetFrameGrabber;
  926.     begin
  927.         case FrameGrabber of
  928.             QuickCapture: 
  929.                 ResetQuickCapture;
  930.             ScionLG3: 
  931.                 ResetScionLG3;
  932.             ScionAG5: 
  933.                 ResetScionAG5;
  934.             ScionVG5f:
  935.                 ResetScionVG5f;
  936.             otherwise
  937.                 ;
  938.         end;
  939.     end;
  940.  
  941.  
  942.     procedure CopyOffscreen (src, dst: PixMapHandle; sRect, dRect: rect);
  943.         var
  944.             SaveGDevice: GDHandle;
  945.     begin
  946.         SaveGDevice := GetGDevice;
  947.         SetGDevice(osGDevice);
  948.         pmForeColor(BlackIndex);
  949.         pmBackColor(WhiteIndex);
  950.         CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(dst)^^, sRect, dRect, DitherCopy, nil);
  951.         pmForeColor(ForegroundIndex);
  952.         pmBackColor(BackgroundIndex);
  953.         SetGDevice(SaveGDevice);
  954.     end;
  955.  
  956.  
  957.     procedure wait (ticks: LongInt);
  958.         var
  959.             SaveTicks: LongInt;
  960.     begin
  961.         SaveTicks := TickCount + ticks;
  962.         repeat
  963.         until TickCount > SaveTicks;
  964.     end;
  965.  
  966.  
  967.     function GetScrapCount: integer;
  968.         var
  969.             ScrapInfo: PScrapStuff;
  970.     begin
  971.         ScrapInfo := InfoScrap;
  972.         GetScrapCount := ScrapInfo^.ScrapCount;
  973.     end;
  974.  
  975.  
  976.     procedure DisplayText (update: boolean);
  977.         var
  978.             tPort: GrafPtr;
  979.             i, hstart, width, ff: integer;
  980.             MaskRect: rect;
  981.             p1, p2: point;
  982.             SaveGDevice: GDHandle;
  983.     begin
  984.         if (info = NoInfo) or (not IsInsertionPoint) then
  985.             exit(DisplayText);
  986.         if update then
  987.             Undo;
  988.         SaveGDevice := GetGDevice;
  989.         SetGDevice(osGDevice);
  990.         GetPort(tPort);
  991.         SetPort(GrafPtr(Info^.osPort));
  992.         pmForeColor(ForegroundIndex);
  993.         pmBackColor(BackgroundIndex);
  994.         TextFont(CurrentFontID);
  995.         TextFace(CurrentStyle);
  996.         TextSize(CurrentSize);
  997.         if TextBack = NoBack then
  998.             TextMode(SrcOr)
  999.         else
  1000.             TextMode(SrcCopy);
  1001.         width := StringWidth(TextStr);
  1002.         case TextJust of
  1003.             teJustLeft: 
  1004.                 hstart := TextStart.h;
  1005.             teJustCenter: 
  1006.                 hstart := TextStart.h - width div 2;
  1007.             teJustRight: 
  1008.                 hstart := TextStart.h - width;
  1009.         end;
  1010.         if hstart < 0 then
  1011.             hstart := 0;
  1012.         MoveTo(hstart, TextStart.v);
  1013.         DrawString(TextStr);
  1014.         GetPen(InsertionPoint);
  1015.         ff := CurrentSize * 2;
  1016.         p1.h := hstart - ff;
  1017.         p1.v := TextStart.v - CurrentSize;
  1018.         p2.h := TextStart.h + width + ff;
  1019.         p2.v := TextStart.v + CurrentSize div 3;
  1020.         Pt2Rect(p1, p2, MaskRect);
  1021.         UpdateScreen(MaskRect);
  1022.         SetPort(tPort);
  1023.         SetGDevice(SaveGDevice);
  1024.         Info^.changes := true;
  1025.     end;
  1026.  
  1027.  
  1028.     procedure OffScreenToScreenRect (var r: rect);
  1029.         var
  1030.             p1, p2: point;
  1031.     begin
  1032.         with r do begin
  1033.                 p1.h := left;
  1034.                 p1.v := top;
  1035.                 p2.h := right;
  1036.                 p2.v := bottom;
  1037.                 OffScreenToScreen(p1);
  1038.                 OffScreenToScreen(p2);
  1039.                 Pt2Rect(p1, p2, r);
  1040.             end;
  1041.     end;
  1042.  
  1043.  
  1044.     procedure ScreenToOffscreen (var loc: point);
  1045.     begin
  1046.         with loc, Info^ do begin
  1047.                 h := SrcRect.left + trunc(h / magnification);
  1048.                 v := SrcRect.top + trunc(v / magnification);
  1049.             end;
  1050.     end;
  1051.  
  1052.  
  1053.     procedure OffscreenToScreen (var loc: point);
  1054.     begin
  1055.         with loc, Info^ do begin
  1056.                 h := trunc((h - SrcRect.left) * magnification);
  1057.                 v := trunc((v - SrcRect.top) * magnification);
  1058.             end;
  1059.     end;
  1060.  
  1061.  
  1062.  
  1063.     procedure UpdateScreen (MaskRect: rect);
  1064.  {Refreshes the portion of the screen defined by}
  1065.   {MaskRect, where MaskRect is defined in offscreen coordinates.}
  1066.         var
  1067.             tPort: GrafPtr;
  1068.             imag: integer;
  1069.             SaveGDevice: GDHandle;
  1070.     begin
  1071.         OffScreenToScreenRect(MaskRect);
  1072.         with Info^ do
  1073.             if info <> NoInfo then begin
  1074.                     SaveGDevice := GetGDevice;
  1075.                     SetGDevice(GetMainDevice);
  1076.                     getPort(tPort);
  1077.                     SetPort(wptr);
  1078.                     SetFColor(BlackIndex);
  1079.                     SetBColor(WhiteIndex);
  1080.                     imag := trunc(magnification);
  1081.                     InsetRect(MaskRect, -imag * 2 * LineWidth, -imag * 2 * LineWidth);
  1082.                     InsetRect(MaskRect, 0, 0);
  1083.                     RectRgn(MaskRgn, MaskRect);
  1084.                     CopyBits(BitMapHandle(osPort^.PortPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, gCopyMode, MaskRgn);
  1085.                     SetPort(tPort);
  1086.                     SetGDevice(SaveGDevice);
  1087.                 end;
  1088.     end;
  1089.  
  1090.  
  1091.     procedure RestoreRoi;
  1092.     begin
  1093.         with Info^ do begin
  1094.                 SetupUndo;
  1095.                 if RoiShowing then
  1096.                     UpdateScreen(RoiRect);
  1097.                 roiType := NoInfo^.roiType;
  1098.                 RoiRect := NoInfo^.RoiRect;
  1099.                 CopyRgn(NoInfo^.roiRgn, roiRgn);
  1100.                 LX1 := NoInfo^.LX1;
  1101.                 LY1 := NoInfo^.LY1;
  1102.                 LX2 := NoInfo^.LX2;
  1103.                 LY2 := NoInfo^.LY2;
  1104.                 LAngle := NoInfo^.LAngle;
  1105.                 RoiShowing := true;
  1106.                 measuring := false;
  1107.             end;
  1108.     end;
  1109.  
  1110.  
  1111.     procedure Undo;
  1112.         var
  1113.             SrcPtr: ptr;
  1114.             line: integer;
  1115.     begin
  1116.         if info^.PixMapSize <> CurrentUndoSize then
  1117.             exit(Undo);
  1118.         if UndoFromClip then begin
  1119.                 if info^.PixMapSize > ClipBufSize then
  1120.                     exit(Undo);
  1121.                 SrcPtr := ClipBuf;
  1122.             end
  1123.         else
  1124.             SrcPtr := UndoBuf;
  1125.         with info^ do
  1126.             BlockMove(SrcPtr, PicBaseAddr, PixMapSize);
  1127.         if UndoFromClip and RestoreUndoBuf then
  1128.             with info^ do
  1129.                 BlockMove(SrcPtr, UndoBuf, PixMapSize);
  1130.         if RedoSelection then
  1131.             RestoreRoi;
  1132.     end;
  1133.  
  1134.  
  1135.     function MyGetPixel (h, v: LongInt): integer;
  1136.     begin
  1137.         MyGetPixel := BackgroundIndex;
  1138.         with Info^ do
  1139.             if h >= 0 then
  1140.                 if v >= 0 then
  1141.                     if h < PixelsPerLine then
  1142.                         if v < nlines then
  1143.                             MyGetPixel := ImageP(PicBaseAddr)^[v * BytesPerRow + h];
  1144.                {MyGetPixel := band(ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h)^, 255);}
  1145.     end;
  1146.  
  1147.  
  1148.     procedure PutPixel (h, v: LongInt; value: integer);
  1149.         var
  1150.             addr: Ptr;
  1151.     begin
  1152.         with Info^ do
  1153.             if h >= 0 then
  1154.                 if v >= 0 then
  1155.                     if h < PixelsPerLine then
  1156.                         if v < nlines then begin
  1157.                                 addr := Ptr(Ord4(PicBaseAddr) + v * BytesPerRow + h);
  1158.                                 addr^ := value;
  1159.                             end;
  1160.     end;
  1161.  
  1162.  
  1163.     procedure GetLine (h, v, count: LongInt; var line: LineType);
  1164.         var
  1165.             offset: LongInt;
  1166.             p: ptr;
  1167.             i: integer;
  1168.     begin
  1169.         if count > MaxLine then
  1170.             count := MaxLine;
  1171.         with Info^ do begin
  1172.                 if (h < 0) or (v < 0) or ((h + count) > PixelsPerLine) or (v >= nlines) then begin
  1173.                         for i := 0 to count - 1 do
  1174.                             line[i] := MyGetPixel(h + i, v);
  1175.                         exit(GetLine);
  1176.                     end;
  1177.                 offset := v * BytesPerRow + h;
  1178.                 p := ptr(ord4(PicBaseAddr) + offset);
  1179.                 BlockMove(p, @line, count);
  1180.             end;
  1181.     end;
  1182.  
  1183.  
  1184.     procedure GetColumn (h, v, count: LongInt; var data: LineType);
  1185.         var
  1186.             col, pic, bpr: LongInt;
  1187.             i: integer;
  1188.     begin
  1189.         if count > MaxLine then
  1190.             count := MaxLine;
  1191.         with Info^ do begin
  1192.                 if (h < 0) or (v < 0) or (h >= PixelsPerLine) or ((v + count) > nlines) then begin
  1193.                         for i := 0 to count - 1 do
  1194.                             data[i] := MyGetPixel(h, v + i);
  1195.                         exit(GetColumn);
  1196.                     end;
  1197.                 col := Ord4(@data);
  1198.                 bpr := BytesPerRow;
  1199.                 pic := Ord4(PicBaseAddr) + v * bpr + h;
  1200.                 while count > 0 do begin
  1201.                         Ptr(col)^ := Ptr(pic)^;
  1202.                         pic := pic + bpr;
  1203.                         col := col + 1;
  1204.                         count := count - 1;
  1205.                     end;
  1206.             end;
  1207.     end;
  1208.  
  1209.  
  1210.     procedure PutColumn (hstart, vstart, count: LongInt; var data: LineType);
  1211.         var
  1212.             col, pic, bpr: LongInt;
  1213.     begin
  1214.         col := Ord4(@data);
  1215.         with Info^ do begin
  1216.                 bpr := BytesPerRow;
  1217.                 if count > 0 then
  1218.                     if hstart >= 0 then
  1219.                         if vstart >= 0 then
  1220.                             if hstart < PixelsPerLine then begin
  1221.                                     if vstart > nlines - count then
  1222.                                         count := nlines - vstart;
  1223.                                     pic := Ord4(PicBaseAddr) + vstart * bpr + hstart;
  1224.                                     while count > 0 do begin
  1225.                                             Ptr(pic)^ := Ptr(col)^;
  1226.                                             pic := pic + bpr;
  1227.                                             col := col + 1;
  1228.                                             count := count - 1;
  1229.                                         end;
  1230.                                 end;
  1231.             end;
  1232.     end;
  1233.  
  1234.  
  1235.     procedure PutLine (h, v, count: LongInt; var line: LineType);
  1236.         var
  1237.             offset: LongInt;
  1238.             p: ptr;
  1239.     begin
  1240.         with Info^ do begin
  1241.                 if (h < 0) or (v < 0) or (v >= nlines) then
  1242.                     exit(PutLine);
  1243.                 if (h + count) > PixelsPerLine then
  1244.                     count := PixelsPerLine - h;
  1245.                 offset := v * BytesPerRow + h;
  1246.                 p := ptr(ord4(PicBaseAddr) + offset);
  1247.                 BlocKMove(@line, p, count);
  1248.             end;
  1249.     end;
  1250.  
  1251.  
  1252.     procedure Show1Value (rvalue, CalibratedValue: extended);
  1253.         var
  1254.             tPort: GrafPtr;
  1255.             hstart, vstart, ivalue: integer;
  1256.     begin
  1257.         hstart := InfoHStart;
  1258.         vstart := InfoVStart;
  1259.         GetPort(tPort);
  1260.         SetPort(InfoWindow);
  1261.         TextSize(9);
  1262.         TextFont(Monaco);
  1263.         TextMode(SrcCopy);
  1264.         MoveTo(xValueLoc, vstart);
  1265.         if CalibratedValue <> NoValue then begin
  1266.                 DrawReal(CalibratedValue, 5, 2);
  1267.                 DrawString(' (');
  1268.                 DrawReal(rvalue, 3, 0);
  1269.                 DrawString(')');
  1270.             end
  1271.         else
  1272.             DrawReal(rvalue, 6, 2);
  1273.         DrawString('    ');
  1274.         SetPort(tPort);
  1275.     end;
  1276.  
  1277.  
  1278.     procedure Show2PlotValues (x, y: extended);
  1279.         var
  1280.             tPort: GrafPtr;
  1281.             hstart, vstart, ivalue: integer;
  1282.     begin
  1283.         with info^ do begin
  1284.                 hstart := InfoHStart;
  1285.                 vstart := InfoVStart;
  1286.                 GetPort(tPort);
  1287.                 SetPort(InfoWindow);
  1288.                 TextSize(9);
  1289.                 TextFont(Monaco);
  1290.                 TextMode(SrcCopy);
  1291.                 MoveTo(xValueLoc, vstart);
  1292.                 DrawXDimension(round(x), 0);
  1293.                 MoveTo(yValueLoc, vstart + 10);
  1294.                 DrawReal(y, 6, 2);
  1295.                 SetPort(tPort);
  1296.             end;
  1297.     end;
  1298.  
  1299.  
  1300.     procedure Show2Values (current, total: LongInt);
  1301.         var
  1302.             tPort: GrafPtr;
  1303.             hstart, vstart, ivalue: integer;
  1304.     begin
  1305.         hstart := InfoHStart;
  1306.         vstart := InfoVStart;
  1307.         GetPort(tPort);
  1308.         SetPort(InfoWindow);
  1309.         TextSize(9);
  1310.         TextFont(Monaco);
  1311.         TextMode(SrcCopy);
  1312.         MoveTo(xValueLoc, vstart);
  1313.         DrawLong(current);
  1314.         DrawString('     ');
  1315.         MoveTo(yValueLoc, vstart + 10);
  1316.         DrawLong(total);
  1317.         DrawString('     ');
  1318.         SetPort(tPort);
  1319.     end;
  1320.  
  1321.  
  1322.     procedure DrawXDimension (x: extended; digits: integer);
  1323.     begin
  1324.         with info^ do begin
  1325.                 if SpatiallyCalibrated then begin
  1326.                         DrawReal(x / xScale, 5, 2);
  1327.                         DrawChar(xUnit[1]);
  1328.                         DrawChar(xUnit[2]);
  1329.                         DrawString(' (');
  1330.                         DrawReal(x, 3, digits);
  1331.                         DrawString(')')
  1332.                     end
  1333.                 else
  1334.                     DrawReal(x, 1, digits);
  1335.                 DrawString('      ');
  1336.             end;
  1337.     end;
  1338.  
  1339.  
  1340.     procedure DrawYDimension (y: extended; digits: integer);
  1341.     begin
  1342.         with info^ do begin
  1343.                 if SpatiallyCalibrated then begin
  1344.                         DrawReal(y / yScale, 5, 2);
  1345.                         DrawChar(xUnit[1]);
  1346.                         DrawChar(xUnit[2]);
  1347.                         DrawString(' (');
  1348.                         DrawReal(y, 3, digits);
  1349.                         DrawString(')')
  1350.                     end
  1351.                 else
  1352.                     DrawReal(y, 1, digits);
  1353.                 DrawString('      ');
  1354.             end;
  1355.     end;
  1356.  
  1357.  
  1358.     procedure DrawRGB (index: integer);
  1359.         var
  1360.             rStr, gStr, bStr: str255;
  1361.             TempRGB: rgbColor;
  1362.             i, entry: integer;
  1363.  
  1364.         procedure Convert (n: integer; var str: str255);
  1365.             var
  1366.                 i: integer;
  1367.         begin
  1368.             RealToString(n, 3, 0, str);
  1369.             for i := 1 to 3 do
  1370.                 if str[i] = ' ' then
  1371.                     str[i] := '0';
  1372.         end;
  1373.  
  1374.     begin
  1375.         TempRGB := cScreenPort^.portPixMap^^.pmTable^^.ctTable[index].rgb;
  1376.         with TempRGB do begin
  1377.                 Convert(band(bsr(red, 8), 255), rStr);
  1378.                 Convert(band(bsr(green, 8), 255), gStr);
  1379.                 Convert(band(bsr(blue, 8), 255), bStr);
  1380.                 DrawString(concat(rStr, ' ', gStr, ' ', bStr));
  1381.             end;
  1382.     end;
  1383.  
  1384.  
  1385.     procedure Show3Values (hloc, vloc, ivalue: LongInt);
  1386.         var
  1387.             tPort: GrafPtr;
  1388.             hstart, vstart: integer;
  1389.     begin
  1390.         with info^ do begin
  1391.                 hstart := InfoHStart;
  1392.                 vstart := InfoVStart;
  1393.                 GetPort(tPort);
  1394.                 SetPort(InfoWindow);
  1395.                 TextSize(9);
  1396.                 TextFont(Monaco);
  1397.                 TextMode(SrcCopy);
  1398.                 if hloc < 0 then
  1399.                     hloc := -hloc;
  1400.                 MoveTo(xValueLoc, vstart);
  1401.                 DrawXDimension(hloc, 0);
  1402.                 if InvertYCoordinates and (ivalue >= 0) then
  1403.                     vloc := PicRect.bottom - vloc - 1;
  1404.                 if vloc < 0 then
  1405.                     vloc := -vloc;
  1406.                 MoveTo(yValueLoc, vstart + 10);
  1407.                 DrawYDimension(vloc, 0);
  1408.                 DrawString('    ');
  1409.                 if ivalue >= 0 then begin
  1410.                         MoveTo(zValueLoc, vstart + 20);
  1411.                         if (fit <> uncalibrated) or (CurrentTool = PickerTool) then begin
  1412.                                 if CurrentTool = PickerTool then
  1413.                                     DrawRGB(ivalue)
  1414.                                 else
  1415.                                     DrawReal(cvalue[ivalue], 5, precision);
  1416.                                 DrawString(' (');
  1417.                                 DrawLong(ivalue);
  1418.                                 DrawString(')');
  1419.                             end
  1420.                         else
  1421.                             DrawLong(ivalue);
  1422.                     end;
  1423.                 DrawString('    ');
  1424.                 SetPort(tPort);
  1425.             end;
  1426.     end;
  1427.  
  1428.  
  1429.     procedure ShowDxDy (X, Y: extended);
  1430.         var
  1431.             tPort: GrafPtr;
  1432.             hstart, vstart, ivalue: integer;
  1433.     begin
  1434.         with info^ do begin
  1435.                 hstart := InfoHStart;
  1436.                 vstart := InfoVStart;
  1437.                 GetPort(tPort);
  1438.                 SetPort(InfoWindow);
  1439.                 TextSize(9);
  1440.                 TextFont(Monaco);
  1441.                 TextMode(SrcCopy);
  1442.                 MoveTo(xValueLoc, vstart);
  1443.                 DrawXDimension(x, 2);
  1444.                 MoveTo(yValueLoc, vstart + 10);
  1445.                 DrawYDimension(y, 2);
  1446.                 MoveTo(zValueLoc, vstart + 20);
  1447.                 if SpatiallyCalibrated then begin
  1448.                         DrawReal(sqrt(sqr(x / xScale) + sqr(y / yScale)), 5, 2);
  1449.                         DrawChar(xUnit[1]);
  1450.                         DrawChar(xUnit[2]);
  1451.                         DrawString(' (');
  1452.                         DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1453.                         DrawString(')')
  1454.                     end
  1455.                 else
  1456.                     DrawReal(sqrt(sqr(x) + sqr(y)), 1, 2);
  1457.                 DrawString('    ');
  1458.                 SetPort(tPort);
  1459.             end;
  1460.     end;
  1461.  
  1462.  
  1463.     procedure PutChar (c: char);
  1464.     begin
  1465.         if TextBufSize < MaxTextBufSize then begin
  1466.                 TextBufSize := TextBufSize + 1;
  1467.                 TextBufP^[TextBufSize] := c;
  1468.                 if c = cr then begin
  1469.                         TextBufColumn := 0;
  1470.                         TextBufLineCount := TextBufLineCount + 1
  1471.                     end
  1472.                 else
  1473.                     TextBufColumn := TextBufColumn + 1;
  1474.             end;
  1475.     end;
  1476.  
  1477.  
  1478.     procedure PutTab;
  1479.     begin
  1480.         if not printing then
  1481.             PutChar(tab)
  1482.     end;
  1483.  
  1484.  
  1485.     procedure PutString (str: str255);
  1486.         var
  1487.             i: integer;
  1488.     begin
  1489.         for i := 1 to length(str) do begin
  1490.                 if TextBufSize < MaxTextBufSize then
  1491.                     TextBufSize := TextBufSize + 1;
  1492.                 TextBufP^[TextBufSize] := str[i];
  1493.                 TextBufColumn := TextBufColumn + 1;
  1494.             end;
  1495.     end;
  1496.  
  1497.  
  1498.     procedure PutFString (str: str255; FieldWidth: integer);
  1499.         var
  1500.             LeadingSpaces: integer;
  1501.     begin
  1502.         LeadingSpaces := FieldWidth - length(str);
  1503.         if LeadingSpaces > 0 then
  1504.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1505.         PutString(str);
  1506.     end;
  1507.  
  1508.  
  1509.     procedure PutReal (n: extended; width, fwidth: integer);
  1510.         var
  1511.             str: str255;
  1512.     begin
  1513.         RealToString(n, width, fwidth, str);
  1514.         PutString(str);
  1515.     end;
  1516.  
  1517.  
  1518.     procedure PutLong (n: LongInt; FieldWidth: integer);
  1519.         var
  1520.             str: str255;
  1521.             LeadingSpaces: integer;
  1522.     begin
  1523.         NumToString(n, str);
  1524.         LeadingSpaces := FieldWidth - length(str);
  1525.         if LeadingSpaces > 0 then
  1526.             str := concat(copy('            ', 1, LeadingSpaces), str);
  1527.         PutString(str);
  1528.     end;
  1529.  
  1530.  
  1531.     procedure CopyResultsToBuffer (FirstCount, LastCount: integer; Headings: boolean);
  1532.         var
  1533.             i, column, fwidth: integer;
  1534.             m: MeasurementTypes;
  1535.  
  1536.         procedure PutSequenceNumber;
  1537.         begin
  1538.             PutLong(i, 4);
  1539.             PutChar('.');
  1540.             PutTab;
  1541.         end;
  1542.  
  1543.         procedure PutUnits;
  1544.         begin
  1545.             if info^.SpatiallyCalibrated then begin
  1546.                     PutString('  (');
  1547.                     DrawChar(info^.xUnit[1]);
  1548.                     DrawChar(info^.xUnit[2]);
  1549.                     PutString(')')
  1550.                 end
  1551.             else
  1552.                 PutString('(Pixels)');
  1553.             PutChar(cr);
  1554.             PutChar(cr);
  1555.         end;
  1556.  
  1557.         procedure PutTabDelimeter;
  1558.         begin
  1559.             Column := Column + 1;
  1560.             if Column <> nListColumns then
  1561.                 PutTab;
  1562.         end;
  1563.  
  1564.     begin
  1565.         if mCount < 1 then begin
  1566.                 TextBufSize := 0;
  1567.                 TextBufLineCount := 0;
  1568.                 exit(CopyResultsToBuffer);
  1569.             end;
  1570.         ShowWatch;
  1571.         Headings := Headings or OptionKeyWasDown;
  1572.         TextBufSize := 0;
  1573.         TextBufColumn := 0;
  1574.         TextBufLineCount := 0;
  1575.         nListColumns := 0;
  1576.         for m := AreaM to StdDevM do
  1577.             if m in Measurements then
  1578.                 nListColumns := nListColumns + 1;
  1579.         if (xyLocM in measurements) or (nPoints > 0) then
  1580.             nListColumns := nListColumns + 2;
  1581.         if ModeM in measurements then
  1582.             nListColumns := nListColumns + 1;
  1583.         if (LengthM in measurements) or (nLengths > 0) then
  1584.             nListColumns := nListColumns + 1;
  1585.         if MajorAxisM in measurements then
  1586.             nListColumns := nListColumns + 1;
  1587.         if MinorAxisM in measurements then
  1588.             nListColumns := nListColumns + 1;
  1589.         if (AngleM in measurements) or (nAngles > 0) then
  1590.             nListColumns := nListColumns + 1;
  1591.         if IntDenM in measurements then
  1592.             nListColumns := nListColumns + 2;
  1593.         if MinMaxM in measurements then
  1594.             nListColumns := nListColumns + 2;
  1595.         if User1M in measurements then
  1596.             nListColumns := nListColumns + 1;
  1597.         if User2M in measurements then
  1598.             nListColumns := nListColumns + 1;
  1599.         with info^ do begin
  1600.                 fwidth := FieldWidth;
  1601.                 if Headings and (FirstCount = 1) then begin
  1602.                         PutFString(' ', 5);
  1603.                         PutTabDelimeter;
  1604.                         if AreaM in measurements then begin
  1605.                                 PutFString('Area', fwidth);
  1606.                                 PutTabDelimeter;
  1607.                             end;
  1608.                         if MeanM in measurements then begin
  1609.                                 PutFString('Mean', fwidth);
  1610.                                 PutTabDelimeter;
  1611.                             end;
  1612.                         if StdDevM in measurements then begin
  1613.                                 PutFString('S.D.', fwidth);
  1614.                                 PutTabDelimeter;
  1615.                             end;
  1616.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1617.                                 PutFString('X', fwidth);
  1618.                                 PutTabDelimeter;
  1619.                                 PutFString('Y', fwidth);
  1620.                                 PutTabDelimeter;
  1621.                             end;
  1622.                         if ModeM in measurements then begin
  1623.                                 PutFString('Mode', fwidth);
  1624.                                 PutTabDelimeter;
  1625.                             end;
  1626.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1627.                                 PutFString('Length', fwidth);
  1628.                                 PutTabDelimeter;
  1629.                             end;
  1630.                         if MajorAxisM in measurements then begin
  1631.                                 PutFString(MajorLabel, fwidth);
  1632.                                 PutTabDelimeter;
  1633.                             end;
  1634.                         if MinorAxisM in measurements then begin
  1635.                                 PutFString(MinorLabel, fwidth);
  1636.                                 PutTabDelimeter;
  1637.                             end;
  1638.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1639.                                 PutFString('Angle', fwidth);
  1640.                                 PutTabDelimeter;
  1641.                             end;
  1642.                         if IntDenM in measurements then begin
  1643.                                 PutFString('Int.Den.', fwidth + 2);
  1644.                                 PutTabDelimeter;
  1645.                                 PutFString('Back.', fwidth);
  1646.                                 PutTabDelimeter;
  1647.                             end;
  1648.                         if MinMaxM in measurements then begin
  1649.                                 PutFString('Min', fwidth);
  1650.                                 PutTabDelimeter;
  1651.                                 PutFString('Max', fwidth);
  1652.                                 PutTabDelimeter;
  1653.                             end;
  1654.                         if User1M in measurements then begin
  1655.                                 PutFString(User1Label, fwidth);
  1656.                                 PutTabDelimeter;
  1657.                             end;
  1658.                         if User2M in measurements then begin
  1659.                                 PutFString(User2Label, fwidth);
  1660.                                 PutTabDelimeter;
  1661.                             end;
  1662.                         PutChar(cr);
  1663.                         PutChar(cr);
  1664.                     end;
  1665.                 for i := FirstCount to LastCount do begin
  1666.                         column := 0;
  1667.                         if Headings then
  1668.                             PutSequenceNumber;
  1669.                         if AreaM in measurements then begin
  1670.                                 PutReal(mArea^[i], fwidth, precision);
  1671.                                 PutTabDelimeter;
  1672.                             end;
  1673.                         if MeanM in measurements then begin
  1674.                                 PutReal(mean^[i], fwidth, precision);
  1675.                                 PutTabDelimeter;
  1676.                             end;
  1677.                         if StdDevM in measurements then begin
  1678.                                 PutReal(sd^[i], fwidth, precision);
  1679.                                 PutTabDelimeter;
  1680.                             end;
  1681.                         if (xyLocM in measurements) or (nPoints > 0) then begin
  1682.                                 PutReal(xcenter^[i], fwidth, precision);
  1683.                                 PutTab;
  1684.                                 PutReal(ycenter^[i], fwidth, precision);
  1685.                                 PutTabDelimeter;
  1686.                             end;
  1687.                         if ModeM in measurements then begin
  1688.                                 PutReal(mode^[i], fwidth, precision);
  1689.                                 PutTabDelimeter;
  1690.                             end;
  1691.                         if (LengthM in measurements) or (nLengths > 0) then begin
  1692.                                 PutReal(plength^[i], fwidth, precision);
  1693.                                 PutTabDelimeter;
  1694.                             end;
  1695.                         if MajorAxisM in measurements then begin
  1696.                                 PutReal(MajorAxis^[i], fwidth, precision);
  1697.                                 PutTabDelimeter;
  1698.                             end;
  1699.                         if MinorAxisM in measurements then begin
  1700.                                 PutReal(MinorAxis^[i], fwidth, precision);
  1701.                                 PutTabDelimeter;
  1702.                             end;
  1703.                         if (AngleM in measurements) or (nAngles > 0) then begin
  1704.                                 PutReal(orientation^[i], fwidth, precision);
  1705.                                 PutTabDelimeter;
  1706.                             end;
  1707.                         if IntDenM in measurements then begin
  1708.                                 PutReal(IntegratedDensity^[i], fwidth + 2, precision);
  1709.                                 PutTabDelimeter;
  1710.                                 PutReal(idBackground^[i], fwidth, precision);
  1711.                                 PutTabDelimeter;
  1712.                             end;
  1713.                         if MinMaxM in measurements then begin
  1714.                                 PutReal(mMin^[i], fwidth, precision);
  1715.                                 PutTabDelimeter;
  1716.                                 PutReal(mMax^[i], fwidth, precision);
  1717.                                 PutTabDelimeter;
  1718.                             end;
  1719.                         if User1M in measurements then begin
  1720.                                 PutReal(User1^[i], fwidth, precision);
  1721.                                 PutTabDelimeter;
  1722.                             end;
  1723.                         if User2M in measurements then begin
  1724.                                 PutReal(User2^[i], fwidth, precision);
  1725.                                 PutTabDelimeter;
  1726.                             end;
  1727.                         PutChar(cr);
  1728.                     end; {for}
  1729.             end; {with}
  1730.     end;
  1731.  
  1732.  
  1733.     procedure ShowWatch;
  1734.     begin
  1735.         SetCursor(watch);
  1736.     end;
  1737.  
  1738.  
  1739.     procedure ShowAnimatedWatch;
  1740.     begin
  1741.         SetCursor(AnimatedWatch[WatchIndex]);
  1742.         WatchIndex := WatchIndex + 1;
  1743.         if WatchIndex > 8 then
  1744.             WatchIndex := 1;
  1745.     end;
  1746.  
  1747.  
  1748.     procedure CaptureImage;
  1749.         var
  1750.             Timeout: LongInt;
  1751.             vdigErr: ComponentResult;
  1752.     begin
  1753.         case FrameGrabber of
  1754.             QuickCapture:  begin
  1755.                     ControlReg^ := BitAnd($80, 255); {Start frame capture}
  1756.                     while BitAnd(ControlReg^, $80) = $80 do
  1757.                         ;       {Wait for it to complete}
  1758.                 end;
  1759.             ScionLG3, ScionAG5, ScionVG5f:  begin
  1760.                     TimeOut := TickCount + 30;  {1/2sec. timeout}
  1761.                     ControlReg^ := $80; {Start frame capture}
  1762.                     while BitAnd(ControlReg^, $80) = $00 do begin    {Wait for it to complete}
  1763.                             if TickCount > TimeOut then begin
  1764.                                     ControlReg^ := $00;
  1765.                                     leave
  1766.                                 end;
  1767.                         end;
  1768.                     ControlReg^ := $00;
  1769.                 end;
  1770.             QTvdig:
  1771.                 if vdig <> nil then
  1772.                     vdigErr := VDGrabOneFrame(vdig);
  1773.         end; {case}
  1774.     end;
  1775.  
  1776.  
  1777.     procedure Paste;
  1778.         var
  1779.             srcPixMap: PixMapHandle;
  1780.     begin
  1781.         if info = NoInfo then begin
  1782.                 beep;
  1783.                 exit(Paste)
  1784.             end;
  1785.         with Info^ do begin
  1786.                 if not RoiShowing then
  1787.                     exit(Paste);
  1788.                 if PasteTransferMode = SrcCopy then begin
  1789.                         pmForeColor(BlackIndex);
  1790.                         pmBackColor(WhiteIndex);
  1791.                     end;
  1792.                 srcPixMap := ClipBufInfo^.osPort^.PortPixMap;
  1793.                 if LivePasteMode then
  1794.                     if ((WhatsOnClip = CameraPic) or (WhatsOnClip = LivePic)) and (PictureType <> FrameGrabberType) then begin
  1795.                             CaptureImage;
  1796.                             srcPixMap := fgPixMap;
  1797.                         end;
  1798.                 CopyBits(BitMapHandle(srcPixMap)^^, BitMapHandle(osPort^.PortPixMap)^^, ClipBufInfo^.RoiRect, RoiRect, PasteTransferMode, roiRgn);
  1799.                 if PasteTransferMode = SrcCopy then begin
  1800.                         pmForeColor(ForegroundIndex);
  1801.                         pmBackColor(BackgroundIndex);
  1802.                     end;
  1803.             end;
  1804.     end;
  1805.  
  1806.  
  1807.     procedure DoOperation (Operation: OpType);
  1808.         var
  1809.             tPort: GrafPtr;
  1810.             loc: point;
  1811.             width, height, SaveWidth: integer;
  1812.             tRect: rect;
  1813.             SaveGDevice: GDHandle;
  1814.     begin
  1815.         SaveGDevice := GetGDevice;
  1816.         GetPort(tPort);
  1817.         with Info^ do begin
  1818.                 changes := true;
  1819.                 SetGDevice(osGDevice);
  1820.                 SetPort(GrafPtr(osPort));
  1821.                 pmForeColor(ForegroundIndex);
  1822.                 pmBackColor(BackgroundIndex);
  1823.                 PenNormal;
  1824.                 case Operation of
  1825.                     InvertOp: 
  1826.                         InvertRgn(roiRgn);
  1827.                     PaintOp: 
  1828.                         PaintRgn(roiRgn);
  1829.                     FrameOp:  begin
  1830.                             if (RoiType = LineRoi) or (RoiType = FreeLineRoi) or (RoiTYpe = SegLineRoi) then
  1831.                                 PenSize(1, 1)
  1832.                             else
  1833.                                 PenSize(LineWidth, LineWidth);
  1834.                             FrameRgn(roiRgn);
  1835.                         end;
  1836.                     EraseOp:begin 
  1837.                             EraseRgn(roiRgn);
  1838.                         end;
  1839.                     PasteOp: 
  1840.                         Paste;
  1841.                     otherwise
  1842.                 end;
  1843.                 if not RoiShowing then begin
  1844.                     UpdateScreen(RoiRect);
  1845.                     end;
  1846.                 if PixMapSize > UndoBufSize then
  1847.                     OpPending := false;
  1848.             end;
  1849.         SetPort(tPort);
  1850.         SetGDevice(SaveGDevice);
  1851.     end;
  1852.  
  1853.  
  1854.     procedure SaveRoi;
  1855.     begin
  1856.         with info^ do
  1857.             if RoiType <> noRoi then begin
  1858.                     NoInfo^.roiType := roiType;
  1859.                     NoInfo^.RoiRect := RoiRect;
  1860.                     CopyRgn(roiRgn, NoInfo^.roiRgn);
  1861.                     NoInfo^.LX1 := LX1;
  1862.                     NoInfo^.LY1 := LY1;
  1863.                     NoInfo^.LX2 := LX2;
  1864.                     NoInfo^.LY2 := LY2;
  1865.                     NoInfo^.LAngle := LAngle;
  1866.                 end;
  1867.     end;
  1868.  
  1869.  
  1870.     procedure KillRoi;
  1871.         var
  1872.             trect: rect;
  1873.     begin
  1874.         with info^ do begin
  1875.                 if RoiShowing then begin
  1876.                         if OpPending then begin
  1877.                                 OpPending := false;
  1878.                                 DoOperation(CurrentOp);
  1879.                             end;
  1880.                         SaveRoi;
  1881.                         RoiShowing := false;
  1882.                         trect := RoiRect;
  1883.                         if RoiType = LineRoi then
  1884.                             InsetRect(trect, -RoiHandleSize, -RoiHandleSize);
  1885.                         UpdateScreen(trect);
  1886.                     end;
  1887.                 RoiType := NoRoi;
  1888.                 RoiUpdateTime := 0;
  1889.             end;
  1890.     end;
  1891.  
  1892.  
  1893.     procedure ShowRoi;
  1894.     begin
  1895.         with info^ do
  1896.             if RoiType <> NoRoi then begin
  1897.                     SetupUndo;
  1898.                     RoiShowing := true;
  1899.                 end;
  1900.     end;
  1901.  
  1902.  
  1903.     procedure SetupUndo;
  1904.         var
  1905.             line: integer;
  1906.     begin
  1907.         WhatToUndo := NothingToUndo;
  1908.         if info = NoInfo then begin
  1909.                 CurrentUndoSize := 0;
  1910.                 exit(SetupUndo)
  1911.             end;
  1912.         with info^ do begin
  1913.                 if PixMapSize > UndoBufSize then begin
  1914.                         CurrentUndoSize := 0;
  1915.                         exit(SetupUndo)
  1916.                     end;
  1917.                 if OpPending then begin
  1918.                         DoOperation(CurrentOp);
  1919.                         OpPending := false;
  1920.                     end;
  1921.                 CurrentUndoSize := PixMapSize;
  1922.                 BlockMove(PicBaseAddr, UndoBuf, PixMapSize);
  1923.                 UndoFromClip := false;
  1924.                 RedoSelection := false;
  1925.             end;
  1926.     end;
  1927.  
  1928.  
  1929.     procedure SetupUndoFromClip;
  1930.         var
  1931.             line: integer;
  1932.     begin
  1933.         WhatToUndo := NothingToUndo;
  1934.         if info = NoInfo then begin
  1935.                 CurrentUndoSize := 0;
  1936.                 exit(SetupUndoFromClip)
  1937.             end;
  1938.         with info^ do begin
  1939.                 if PixMapSize > ClipBufSize then begin
  1940.                         CurrentUndoSize := 0;
  1941.                         exit(SetupUndoFromClip)
  1942.                     end;
  1943.                 if OpPending then begin
  1944.                         DoOperation(CurrentOp);
  1945.                         OpPending := false;
  1946.                     end;
  1947.                 CurrentUndoSize := PixMapSize;
  1948.                 BlockMove(PicBaseAddr, ClipBuf, PixMapSize);
  1949.             end;
  1950.         WhatsOnClip := NothingOnClip;
  1951.         UndofromClip := true;
  1952.         RedoSelection := false;
  1953.     end;
  1954.  
  1955.  
  1956.     function NoSelection: boolean;
  1957.     begin
  1958.         if Info = NoInfo then begin
  1959.                 beep;
  1960.                 NoSelection := true;
  1961.                 exit(NoSelection);
  1962.             end;
  1963.         if not Info^.RoiShowing then begin
  1964.                 PutError('Please use a selection tool to make a selection or use the Select All command.');
  1965.                 AbortMacro;
  1966.             end;
  1967.         NoSelection := not Info^.RoiShowing;
  1968.     end;
  1969.  
  1970.  
  1971.     function NotRectangular;{:boolean}
  1972.     begin
  1973.         with info^ do
  1974.             if RoiShowing and (RoiType <> RectRoi) then begin
  1975.                     PutError('This operation requires a rectangular selection.');
  1976.                     NotRectangular := true;
  1977.                     AbortMacro;
  1978.                 end
  1979.             else
  1980.                 NotRectangular := false;
  1981.     end;
  1982.  
  1983.  
  1984.     procedure GetLoi (var x1, y1, x2, y2: extended);
  1985.     begin
  1986.         with info^, info^.RoiRect do begin
  1987.                 x1 := left + LX1;
  1988.                 y1 := top + LY1;
  1989.                 x2 := left + LX2;
  1990.                 y2 := top + LY2;
  1991.             end;
  1992.     end;
  1993.  
  1994.  
  1995.     function NotInBounds: boolean;
  1996.         var
  1997.             x1, y1, x2, y2: extended;
  1998.     begin
  1999.         NotInBounds := false;
  2000.         with info^, info^.RoiRect do
  2001.             if RoiShowing then begin
  2002.                     if RoiType = LineRoi then begin
  2003.                             GetLoi(x1, y1, x2, y2);
  2004.                             if (x1 >= 0.0) and (y1 >= 0.0) and (x2 <= right) and (y2 <= bottom) then
  2005.                                 exit(NotInBounds);
  2006.                         end;
  2007.                     if (left < 0) or (top < 0) or (right > PicRect.right) or (bottom > PicRect.bottom) then begin
  2008.                             PutError('This operation requires the selection to be entirely within the image.');
  2009.                             NotInBounds := true;
  2010.                             AbortMacro;
  2011.                         end;
  2012.                 end;
  2013.     end;
  2014.  
  2015.  
  2016.     function NoUndo: boolean;
  2017.         var
  2018.             ImageTooLarge: boolean;
  2019.     begin
  2020.         with info^ do
  2021.             ImageTooLarge := (PixMapSize > ClipBufSize) or (PixMapSize > UndoBufSize);
  2022.         if ImageTooLarge then
  2023.             PutError('This operation requires that the Undo and Clipboard buffers be at least as large as the image.');
  2024.         NoUndo := ImageTooLarge;
  2025.     end;
  2026.  
  2027.  
  2028.  
  2029.     procedure PutMemoryAlert;
  2030.     begin
  2031.         if not OpeningFinderFiles then
  2032.             PutError('There is not enough free memory to open this image. Try closing some windows or allocating more memory to NIH Image.');
  2033.         AbortMacro;
  2034.     end;
  2035.  
  2036.  
  2037.     procedure CompactMemory;
  2038.         var
  2039.             size: LongInt;
  2040.             TempInfo: InfoPtr;
  2041.             i: integer;
  2042.     begin
  2043.         for i := 1 to nPics do begin
  2044.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2045.                 hunlock(TempInfo^.PicBaseHandle)
  2046.             end;
  2047.         size := MaxSize;
  2048.         size := MaxMem(size);
  2049.         for i := 1 to nPics do begin
  2050.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  2051.                 with TempInfo^ do begin
  2052.                         hlock(PicBaseHandle);
  2053.                         {$ifc PowerPC}
  2054.                         PicBaseAddr := PicBaseHandle^;
  2055.                         {$elsec}
  2056.                         PicBaseAddr := StripAddress(PicBaseHandle^);
  2057.                         {$endc}
  2058.                         osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  2059.                     end;
  2060.             end;
  2061.     end;
  2062.  
  2063.  
  2064.  
  2065.     function GetBigHandle (NeededSize: LongInt): handle;
  2066. {Allocates a handle and guarantees MinFree contiguous free bytes after allocation . }
  2067. {Does NOT arrange for the new handle to be unlocked during CompactMemory. }
  2068. {GetBigHandle returns nil if CompactMemory fails to obtain enough contiguous free space . }
  2069.         var
  2070.             h: handle;
  2071.             FreeMem: LongInt;
  2072.     begin
  2073.         h := NewHandle(NeededSize);
  2074.         FreeMem := MaxBlock;
  2075.         if (h = nil) or (FreeMem < MinFree) then begin
  2076.                 if h <> nil then
  2077.                     DisposeHandle(h);
  2078.                 if FreeMem > 0 then {Why does FreeMem get set to 0 sometimes and MaxMem}
  2079.                     CompactMemory       {crash, but only when using the Modern Memory Manager?}
  2080.                 else
  2081.                     beep;
  2082.                 h := NewHandle(NeededSize);
  2083.                 FreeMem := MaxBlock;
  2084.             end;
  2085.         if (h = nil) or (FreeMem < MinFree) then begin
  2086.                 if h <> nil then
  2087.                     DisposeHandle(h);
  2088.                 h := nil;
  2089.             end;
  2090.         GetBigHandle := h;
  2091.     end;
  2092.  
  2093.  
  2094.     function GetImageMemory (SaveInfo: infoPtr): ptr;
  2095. {Allocates memory for the PixMap of new image windows. SaveInfo points to the InfoRec of the previous window.}
  2096. {A handle is used, rather than a pointer, since NewPtr(particularly on the ci and fx) is rediculously slow.}
  2097.         var
  2098.             h: handle;
  2099.             NeededSize: LongInt;
  2100.     begin
  2101.         with info^ do begin
  2102.                 if odd(PixelsPerLine) then
  2103.                     BytesPerRow := PixelsPerLine + 1
  2104.                 else
  2105.                     BytesPerRow := PixelsPerLine;
  2106.                 PixMapSize := nlines * BytesPerRow;
  2107.                 ImageSize := nlines * PixelsPerLine;
  2108.                 NeededSize := PixMapSize;
  2109.             end;
  2110.         h := GetBigHandle(NeededSize);
  2111.         if h = nil then begin
  2112.                 DisposePtr(pointer(Info));
  2113.                 PutMemoryAlert;
  2114.                 Info := SaveInfo;
  2115.                 GetImageMemory := nil;
  2116.                 exit(GetImageMemory);
  2117.             end;
  2118.         with info^ do begin
  2119.                 PicBaseHandle := h;
  2120.                 hlock(PicBaseHandle);
  2121.                 {$ifc PowerPC}
  2122.                 GetImageMemory := PicBaseHandle^;
  2123.                 {$elsec}
  2124.                 GetImageMemory := StripAddress(PicBaseHandle^);
  2125.                 {$endc}
  2126.             end;
  2127.     end;
  2128.  
  2129.  
  2130.     procedure UpdateAnalysisMenu;
  2131.         var
  2132.             ShowItems: boolean;
  2133.             i: integer;
  2134.     begin
  2135.         ShowItems := Info <> NoInfo;
  2136.         SetMenuItem(AnalyzemenuH, MeasureItem, ShowItems);
  2137.         SetMenuItem(AnalyzemenuH, AnalyzeItem, ShowItems);
  2138.         SetMenuItem(AnalyzemenuH, HistogramItem, ShowItems);
  2139.         SetMenuItem(AnalyzemenuH, PlotItem, ShowItems);
  2140.         SetMenuItem(AnalyzemenuH, PlotSurfaceItem, ShowItems);
  2141.         SetMenuItem(AnalyzemenuH, SetScaleItem, ShowItems);
  2142.         SetMenuItem(AnalyzemenuH, CalibrateItem, ShowItems);
  2143.         SetMenuItem(AnalyzemenuH, RedoItem, mCount > 0);
  2144.         SetMenuItem(AnalyzemenuH, DeleteItem, mCount > 0);
  2145.         SetMenuItem(AnalyzemenuH, RestoreItem, ShowItems and (NoInfo^.RoiType <> NoRoi));
  2146.         SetMenuItem(AnalyzemenuH, MarkItem, info^.RoiShowing);
  2147.     end;
  2148.  
  2149.  
  2150.     procedure ExtendWindowsMenu (fname: str255; size: LongInt; wptr: WindowPtr);
  2151.         var
  2152.             str, SizeStr: str255;
  2153.     begin
  2154.         if nPics < MaxPics then begin
  2155.                 nPics := nPics + 1;
  2156.                 PicWindow[nPics] := wptr;
  2157.                 NumToString((size + 511) div 1024, SizeStr);
  2158.                 str := concat(fname, '  ', SizeStr, 'K');
  2159.                 AppendMenu(WindowsMenuH, ' ');
  2160.                 SetMenuItemText(WindowsMenuH, nPics + WindowsMenuItems + nTextWindows, str);
  2161.                 InsertMenu(WindowsMenuH, 0);
  2162.             end;
  2163.     end;
  2164.  
  2165.  
  2166.     procedure InvertGrayLevels;
  2167.     begin
  2168.         with info^ do begin
  2169.                 fit := StraightLine;
  2170.                 nCoefficients := 2;
  2171.                 Coefficient[1] := 255.0;
  2172.                 Coefficient[2] := -1.0;
  2173.                 ZeroClip := false;
  2174.                 UnitOfMeasure := '';
  2175.                 nKnownValues := 0;
  2176.                 NoInfo^.fit := StraightLine;
  2177.                 NoInfo^.nCoefficients := 2;
  2178.                 NoInfo^.Coefficient := Coefficient;
  2179.                 NoInfo^.ZeroClip := false;
  2180.                 NoInfo^.UnitOfMeasure := '';
  2181.                 GenerateValues;
  2182.                 UpdateTitleBar;
  2183.             end;
  2184.     end;
  2185.  
  2186.  
  2187.     function GetAngle (dx, dy: extended):extended;
  2188.         var
  2189.             angle:extended;
  2190.             quadrant: (q1, q2orq3, q4);
  2191.     begin
  2192.         if dx <> 0.0 then
  2193.             angle := arctan(dy / dx)
  2194.         else begin
  2195.                 if dy >= 0.0 then
  2196.                     angle := pi / 2.0
  2197.                 else
  2198.                     angle := -pi / 2.0
  2199.             end;
  2200.         angle := (180.0 / pi) * angle;
  2201.         if (dx >= 0.0) and (dy >= 0.0) then
  2202.             quadrant := q1
  2203.         else if dx < 0.0 then
  2204.             quadrant := q2orq3
  2205.         else
  2206.             quadrant := q4;
  2207.         case quadrant of
  2208.             q1: 
  2209.                 ;
  2210.             q2orq3: 
  2211.                 angle := angle + 180.0;
  2212.             q4: 
  2213.                 angle := angle + 360.0;
  2214.         end;
  2215.         GetAngle:=angle; {ppc-bug}
  2216.     end;
  2217.  
  2218.  
  2219.     procedure MakeRegion;
  2220.         var
  2221.             deltax, deltay, x1, y1, x2, y2, xt, yt: integer;
  2222.             dx, dy, pAngle: extended;
  2223.             add: boolean;
  2224.             tPort: GrafPtr;
  2225.     begin
  2226.         with info^ do begin
  2227.                 GetPort(tPort);
  2228.                 SetPort(wptr);
  2229.                 OpenRgn;
  2230.                 case RoiType of
  2231.                     LineRoi:  begin
  2232.                             LAngle:=GetAngle(LX2 - LX1, LY1 - LY2);
  2233.                             x1 := round(LX1);
  2234.                             y1 := round(LY1);
  2235.                             x2 := round(LX2);
  2236.                             y2 := round(LY2);
  2237.                             if (x1 = x2) and (y1 = y2) then begin
  2238.                                     MoveTo(x1, y1);
  2239.                                     LineTo(x1 + 1, y1);
  2240.                                     LineTo(x1 + 1, y1 + 1);
  2241.                                     LineTo(x1, y1 + 1);
  2242.                                     LineTo(x1, y1);
  2243.                                 end
  2244.                             else begin
  2245.                                     add := (LAngle > 90.0) and (LAngle <= 270.0);
  2246.                                     pAngle := (LAngle / 180.0) * pi;
  2247.                                     if add then
  2248.                                         pAngle := pAngle + pi / 2.0
  2249.                                     else
  2250.                                         pAngle := pAngle - pi / 2.0;
  2251.                                     dx := cos(pAngle) * LineWidth;
  2252.                                     dy := -sin(pAngle) * LineWidth;
  2253.                                     MoveTo(x1, y1);
  2254.                                     LineTo(round(x1 + dx), round(y1 + dy));
  2255.                                     LineTo(round(x2 + dx), round(y2 + dy));
  2256.                                     LineTo(x2, y2);
  2257.                                     LineTo(x1, y1);
  2258.                                 end;
  2259.                         end;
  2260.                     OvalRoi: 
  2261.                         FrameOval(RoiRect);
  2262.                     RectRoi: 
  2263.                         FrameRect(RoiRect);
  2264.                     otherwise
  2265.                 end;
  2266.                 CloseRgn(roiRgn);
  2267.                 if RoiType = LineRoi then begin
  2268.                         RoiRect := roiRgn^^.rgnBBox;
  2269.                         with RoiRect do begin
  2270.                                 LX1 := LX1 - left;
  2271.                                 LY1 := LY1 - top;
  2272.                                 LX2 := LX2 - left;
  2273.                                 LY2 := LY2 - top;
  2274.                             end;
  2275.                     end;
  2276.             end;
  2277.         SetPort(tPort);
  2278.     end;
  2279.  
  2280.  
  2281.     procedure SelectAll (visible: boolean);
  2282.         var
  2283.             loc: point;
  2284.             tPort: GrafPtr;
  2285.     begin
  2286.         if info <> NoInfo then
  2287.             with Info^ do begin
  2288.                     KillRoi;
  2289.                     RoiType := RectRoi;
  2290.                     RoiRect := PicRect;
  2291.                     MakeRegion;
  2292.                     if visible then begin
  2293.                             SetupUndo;
  2294.                             RoiShowing := true;
  2295.                             if (magnification > 1.0) and not ScaleToFitWindow then
  2296.                                 Unzoom;
  2297.                             if not macro then begin
  2298.                                     PreviousTool := CurrentTool;
  2299.                                     CurrentTool := SelectionTool;
  2300.                                     isSelectionTool := true;
  2301.                                     GetPort(tPort);
  2302.                                     SetPort(ToolWindow);
  2303.                                     EraseRect(ToolRect[PreviousTool]);
  2304.                                     EraseRect(ToolRect[CurrentTool]);
  2305.                                     InvalRect(ToolRect[PreviousTool]);
  2306.                                     InvalRect(ToolRect[CurrentTool]);
  2307.                                     SetPort(tPort);
  2308.                                 end;
  2309.                         end;
  2310.                     IsInsertionPoint := false;
  2311.                     measuring := false;
  2312.                 end; {with}
  2313.     end;
  2314.  
  2315.  
  2316.     procedure KillOperation;
  2317.     begin
  2318.         if OpPending then
  2319.             with info^ do
  2320.                 if info <> NoInfo then begin
  2321.                         DoOperation(CurrentOp);
  2322.                         RoiShowing := false;
  2323.                         UpdateScreen(RoiRect);
  2324.                         OpPending := false;
  2325.                     end;
  2326.     end;
  2327.  
  2328.  
  2329.     procedure CloneInfo (var OldInfo, NewInfo: PicInfo);
  2330.     begin
  2331.         NewInfo := OldInfo;
  2332.         with NewInfo do begin
  2333.                 PicBaseAddr := nil;
  2334.                 PicBaseHandle := nil;
  2335.                 osPort := nil;
  2336.                 roiRgn := nil;
  2337.                 RoiType := NoRoi;
  2338.                 RoiShowing := false;
  2339.                 Magnification := 1.0;
  2340.                 vref := 0;
  2341.                 wPtr := nil;
  2342.                 ScaleToFitWindow := false;
  2343.                 WindowState := NormalWindow;
  2344.                 StackInfo := nil;
  2345.                 fileVersion := 0;
  2346.                 PictureType := NewPicture;
  2347.                 DataType := EightBits;
  2348.                 changes := false;
  2349.                 DataH := nil;
  2350.                 LittleEndian := false;
  2351.                 InvertedImage := false;
  2352.                 if (not SpatiallyCalibrated and (fit=uncalibrated)) or (nPics=0) then begin
  2353.                     if NoInfo^.SpatiallyCalibrated then begin
  2354.                         SpatiallyCalibrated:=true;
  2355.                         xUnit := NoInfo^.xUnit;
  2356.                         xScale := NoInfo^.xScale;
  2357.                         PixelAspectRatio := NoInfo^.PixelAspectRatio;
  2358.                         yScale := xScale / PixelAspectRatio;
  2359.                     end;
  2360.                     if NoInfo^.fit<>uncalibrated then begin
  2361.                         fit := NoInfo^.fit;
  2362.                         nCoefficients := NoInfo^.nCoefficients;
  2363.                         Coefficient := NoInfo^.Coefficient;
  2364.                         ZeroClip := NoInfo^.ZeroClip;
  2365.                         UnitOfMeasure := NoInfo^.UnitOfMeasure;
  2366.                     end;
  2367.                 end;
  2368.             end;
  2369.     end;
  2370.  
  2371.  
  2372.     function NewPicWindow (name: str255; width, height: integer): boolean;
  2373.         var
  2374.             iptr, p: ptr;
  2375.             lptr: ^LongInt;
  2376.             SaveInfo: InfoPtr;
  2377.             NeededSize: LongInt;
  2378.             trect: rect;
  2379.     begin
  2380.         NewPicWindow := false;
  2381.         PicLeft := PicLeftBase;
  2382.         PicTop := PicTopBase;
  2383.         if (info <> noInfo) then begin
  2384.                 with info^ do begin
  2385.                         GetWindowRect(wptr, trect);
  2386.                         if trect.left = PicLeftBase then
  2387.                             if pos('Camera', name) = 0 then begin
  2388.                                     PicLeft := trect.left + hPicOffset;
  2389.                                     PicTop := trect.top + vPicOffset;
  2390.                                 end;
  2391.                     end;
  2392.             end;
  2393.         if nPics = MaxPics then
  2394.             exit(NewPicWindow);
  2395.         KillOperation;
  2396.         DisableDensitySlice;
  2397.         SaveInfo := Info;
  2398.         iptr := NewPtr(SizeOf(PicInfo));
  2399.         if iptr = nil then begin
  2400.                 PutMemoryAlert;
  2401.                 AbortMacro;
  2402.                 exit(NewPicWindow);
  2403.             end;
  2404.         Info := pointer(iptr);
  2405.         CloneInfo(SaveInfo^, Info^);
  2406.         with Info^ do begin
  2407.                 nlines := height;
  2408.                 PixelsPerLine := width;
  2409.                 p := GetImageMemory(SaveInfo);
  2410.                 if p = nil then
  2411.                     exit(NewPicWindow);
  2412.                 PicBaseAddr := p;
  2413.                 MakeNewWindow(name);
  2414.                 SelectAll(false);
  2415.                 if not OptionKeyDown then DoOperation(EraseOp);
  2416.                 KillRoi;
  2417.                 Changes := false;
  2418.                 BinaryPic := false;
  2419.             end;
  2420.         UpdateTitleBar;
  2421.         NewPicWindow := true;
  2422.     end;
  2423.  
  2424.  
  2425.     procedure EraseScreen;
  2426.     begin
  2427.         SetPort(GrafPtr(CScreenPort));
  2428.         with CScreenPort^ do begin
  2429.                 HideCursor;
  2430.                 pmBackColor(BackgroundIndex);
  2431.                 EraseRect(portPixMap^^.Bounds);
  2432.                 pmBackColor(WhiteIndex);
  2433.             end;
  2434.     end;
  2435.  
  2436.  
  2437.     procedure RestoreScreen;
  2438.         var
  2439.             GrayRgn: RgnHandle;
  2440.             rptr: rhptr;
  2441.             wp: ^WindowPtr;
  2442.     begin
  2443.         rptr := rhptr(GrayRgnGlobal);
  2444.         GrayRgn := rptr^;
  2445.         wp := pointer(GhostWindow);
  2446.         wp^ := WindowPtr(nil);
  2447.         PaintBehind(WindowRef(FrontWindow), GrayRgn);
  2448.         wp^ := PasteControl;
  2449.         DrawMenuBar;
  2450.         InitCursor;
  2451.     end;
  2452.  
  2453.  
  2454.     procedure UpdateTitleBar;
  2455.     {Updates the window title bar to show the current magnification or the current frame within a stack.}
  2456.         var
  2457.             str, str2, str3: str255;
  2458.     begin
  2459.         with info^ do begin
  2460.                 str := title;
  2461.                 if info^.DataH <> nil then
  2462.                     str := concat('<<',str, '>>');
  2463.                 if SpatiallyCalibrated then
  2464.                     str := concat(str, chr($13)); {Black Diamond}
  2465.                 if fit <> uncalibrated then
  2466.                     str := concat(str, '◊');
  2467.                 if StackInfo <> nil then
  2468.                     with StackInfo^ do
  2469.                         if (nSlices = 3) and (StackType = rgbStack) then begin
  2470.                                 case CurrentSlice of
  2471.                                     1: str2 := 'Red';
  2472.                                     2: str2 := 'Green';
  2473.                                     3: str2 := 'Blue';
  2474.                                 end;
  2475.                                 str := concat(str, ' (', str2, ')');
  2476.                         end else begin
  2477.                                 NumToString(CurrentSlice, str2);
  2478.                                 NumToString(nSlices, str3);
  2479.                                 str := concat(str, ' (', str2, '/', str3, ')');
  2480.                         end
  2481.                 else if (magnification <> 1.0) or ScaleToFitWindow then begin
  2482.                         if ScaleToFitWindow then begin
  2483.                                 RealToString(magnification, 1, 2, str2);
  2484.                                 str := concat(str, ' (', str2, ')');
  2485.                             end
  2486.                         else begin
  2487.                                 RealToString(magnification, 1, 0, str2);
  2488.                                 str := concat(str, ' (', str2, ':1)');
  2489.                             end;
  2490.                     end;
  2491.                 if Digitizing then begin
  2492.                         if ExternalTrigger then
  2493.                             str := concat(str, ' (Waiting for Trigger)')
  2494.                         else
  2495.                             str := concat(str, ' (Live)');
  2496.                     end;
  2497.                 if wptr <> nil then
  2498.                     SetWTitle(wptr, str);
  2499.             end; {with}
  2500.     end;
  2501.  
  2502.  
  2503.     procedure ScaleToFit;
  2504.         var
  2505.             trect: rect;
  2506.     begin
  2507.         if digitizing then
  2508.             exit(ScaleToFit);
  2509.         if info <> NoInfo then
  2510.             with info^ do begin
  2511.                     ScaleToFitWindow := not ScaleToFitWindow;
  2512.                     KillRoi;
  2513.                     if ScaleToFitWindow then begin
  2514.                             savewrect := wrect;
  2515.                             SaveSrcRect := SrcRect;
  2516.                             SaveMagnification := magnification;
  2517.                             GetWindowRect(wptr, trect);
  2518.                             savehloc := trect.left;
  2519.                             savevloc := trect.top;
  2520.                             wrect := wptr^.PortRect;
  2521.                             SrcRect := PicRect;
  2522.                             ScaleImageWindow(wrect);
  2523.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2524.                         end
  2525.                     else begin
  2526.                             if WindowState = TiledBigScaled then begin
  2527.                                     wrect := initwrect;
  2528.                                     SrcRect := wrect;
  2529.                                     magnification := 1.0;
  2530.                                     WindowState := NormalWindow;
  2531.                                 end
  2532.                             else begin
  2533.                                     wrect := savewrect;
  2534.                                     SrcRect := SaveSrcRect;
  2535.                                     magnification := SaveMagnification;
  2536.                                 end;
  2537.                             HideWindow(wptr);
  2538.                             SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2539.                             MoveWindow(wptr, savehloc, savevloc, true);
  2540.                             ShowWindow(wptr);
  2541.                             UpdateTitleBar;
  2542.                         end;
  2543.                     SetPort(wptr);
  2544.                     InvalRect(wrect);
  2545.                     WindowState := NormalWindow;
  2546.                 end;
  2547.     end;
  2548.  
  2549.  
  2550.     procedure DrawMyGrowIcon (w: WindowPtr);
  2551.         var
  2552.             tPort: GrafPtr;
  2553.             tRect: rect;
  2554.     begin
  2555.         GetPort(tPort);
  2556.         SetPort(w);
  2557.         PenNormal;
  2558.         with w^.PortRect do begin
  2559.                 SetRect(tRect, right - 12, bottom - 12, right - 5, bottom - 5);
  2560.                 FrameRect(tRect);
  2561.                 MoveTo(right - 6, bottom - 10);
  2562.                 LineTo(right - 2, bottom - 10);
  2563.                 LineTo(right - 2, bottom - 2);
  2564.                 LineTo(right - 10, bottom - 2);
  2565.                 LineTo(right - 10, bottom - 6);
  2566.             end;
  2567.         SetPort(tPort);
  2568.     end;
  2569.  
  2570.  
  2571.     procedure Unzoom;
  2572.     begin
  2573.         if Info <> NoInfo then
  2574.             with Info^ do begin
  2575.                     ScaleToFitWindow:=false;
  2576.                     wrect := initwrect;
  2577.                     SrcRect := wrect;
  2578.                     SizeWindow(wptr, wrect.right, wrect.bottom, true);
  2579.                     LoadLUT(info^.cTable);
  2580.                     UpdatePicWindow;
  2581.                     magnification := 1.0;
  2582.                     DrawMyGrowIcon(wptr);
  2583.                     UpdateTitleBar;
  2584.                     WindowState:=NormalWindow;
  2585.                     if WhatToUndo = UndoZoom then
  2586.                         WhatToUndo := NothingToUndo;
  2587.                     ShowRoi;
  2588.                 end;
  2589.     end;
  2590.  
  2591.  
  2592.     procedure DrawBString(str:string);
  2593.     var
  2594.         s:style;
  2595.     begin
  2596.         TextFace([bold]);
  2597.         DrawString(str);
  2598.         s:=[];  {ppc-bug}
  2599.         TextFace(s);
  2600.     end;
  2601.  
  2602.  
  2603.     function long2str (num: LongInt): str255;
  2604.         var
  2605.             str: str255;
  2606.     begin
  2607.         NumToString(num, str);
  2608.         long2str := str;
  2609.     end;
  2610.  
  2611.  
  2612.     procedure PutWarning;
  2613.     begin
  2614.         PutError(concat('This ', long2str((info^.PixmapSize + 511) div 1024), 'K image is larger than the ', long2str(UndoBufSize div 1024), 'K Undo buffer. Many operations may fail or be Undoable.'));
  2615.     end;
  2616.  
  2617.  
  2618.     procedure SetupRoiRect;
  2619. {Copies the current image to Undo buffer so it can be used for drawing}
  2620. {the "marching ants". The copy of the previous image in the Clipboard buffer}
  2621. { buffer will be used for Undo.}
  2622.         var
  2623.             SaveWhatToUndo: WhatToUndoType;
  2624.     begin
  2625.         SaveWhatToUndo := WhatToUndo;
  2626.         SetupUndo;
  2627.         UndoFromClip := true;
  2628.         info^.RoiShowing := true;
  2629.         WhatToUndo := SaveWhatToUndo;
  2630.     end;
  2631.  
  2632.  
  2633.     procedure SetForegroundColor (color: integer);
  2634.         var
  2635.             tPort: GrafPtr;
  2636.             SaveGDevice: GDHandle;
  2637.     begin
  2638.         if (color >= 0) and (color <= 255) then
  2639.             with info^ do begin
  2640.                     ForegroundIndex := color;
  2641.                     GetPort(tPort);
  2642.                     SetPort(ToolWindow);
  2643.                     InvalRect(ToolRect[brush]);
  2644.                     SaveGDevice := GetGDevice;
  2645.                     SetGDevice(osGDevice);
  2646.                     if osPort <> nil then begin
  2647.                             SetPort(GrafPtr(osPort));
  2648.                             pmForeColor(ForegroundIndex);
  2649.                         end;
  2650.                     SetPort(tPort);
  2651.                     SetGDevice(SaveGDevice);
  2652.                     if isInsertionPoint then
  2653.                         DisplayText(true);
  2654.                 end;
  2655.     end;
  2656.  
  2657.  
  2658.     procedure SetBackgroundColor (color: integer);
  2659.         var
  2660.             tPort: GrafPtr;
  2661.             SaveGDevice: GDHandle;
  2662.     begin
  2663.         if (color >= 0) and (color <= 255) then
  2664.             with info^ do begin
  2665.                     BackgroundIndex := color;
  2666.                     GetPort(tPort);
  2667.                     SetPort(ToolWindow);
  2668.                     InvalRect(ToolRect[eraser]);
  2669.                     SaveGDevice := GetGDevice;
  2670.                     SetGDevice(osGDevice);
  2671.                     if osPort <> nil then begin
  2672.                             SetPort(GrafPtr(osPort));
  2673.                             pmBackColor(BackgroundIndex);
  2674.                         end;
  2675.                     SetPort(tPort);
  2676.                     SetGDevice(SaveGDevice);
  2677.                     if isInsertionPoint then
  2678.                         DisplayText(true);
  2679.                 end;
  2680.     end;
  2681.  
  2682.  
  2683.     procedure GetForegroundColor (event: EventRecord);
  2684.         var
  2685.             loc: point;
  2686.             color: integer;
  2687.     begin
  2688.         loc := event.where;
  2689.         ScreenToOffScreen(loc);
  2690.         Color := MyGetPixel(loc.h, loc.v);
  2691.         SetForegroundColor(color);
  2692.     end;
  2693.  
  2694.  
  2695.     procedure GetBackgroundColor; {(event: EventRecord)}
  2696.         var
  2697.             loc: point;
  2698.             color: integer;
  2699.     begin
  2700.         loc := event.where;
  2701.         ScreenToOffScreen(loc);
  2702.         Color := MyGetPixel(loc.h, loc.v);
  2703.         SetBackgroundColor(color);
  2704.     end;
  2705.  
  2706.  
  2707. procedure GenerateValues;
  2708.         var
  2709.             a, b, c, d, e, f, x, y: extended;
  2710.             i: integer;
  2711.     begin
  2712.         with info^ do begin
  2713.                 if fit = uncalibrated then begin
  2714.                         for i := 0 to 255 do
  2715.                             cvalue[i] := i;
  2716.                         minCValue := 0.0;
  2717.                         maxCValue := 255.0;
  2718.                         exit(GenerateValues);
  2719.                     end;
  2720.                 a := Coefficient[1];
  2721.                 b := Coefficient[2];
  2722.                 c := Coefficient[3];
  2723.                 d := Coefficient[4];
  2724.                 e := Coefficient[5];
  2725.                 f := Coefficient[6];
  2726.                 minCValue := 10e+12;
  2727.                 maxCValue := -minCValue;
  2728.                 for i := 0 to 255 do begin
  2729.                         x := i;
  2730.                         case fit of
  2731.                             StraightLine: 
  2732.                                 y := a + b * x;
  2733.                             Poly2: 
  2734.                                 y := a + b * x + c * x * x;
  2735.                             Poly3: 
  2736.                                 y := a + b * x + c * x * x + d * x * x * x;
  2737.                             Poly4: 
  2738.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x;
  2739.                             Poly5: 
  2740.                                 y := a + b * x + c * x * x + d * x * x * x + e * x * x * x * x + f * x * x * x * x * x;
  2741.                             ExpoFit: 
  2742.                                 y := a * exp(b * x);
  2743.                             PowerFit: 
  2744.                                 if x = 0.0 then
  2745.                                     y := 0.0
  2746.                                 else
  2747.                                     y := a * exp(b * ln(x)); {y=ax^b}
  2748.                             LogFit:  begin
  2749.                                     if x = 0.0 then
  2750.                                         x := 0.5;
  2751.                                     y := a * ln(b * x)
  2752.                                 end;
  2753.                             RodbardFit:  begin
  2754.                                     if x <= a then
  2755.                                         y := 0
  2756.                                     else begin
  2757.                                             y := (a - x) / (x - d);
  2758.                                             y := exp(ln(y) * (1 / b));  {y:=y**(1/b)}
  2759.                                             y := y * c;
  2760.                                         end;
  2761.                                 end;
  2762.                             UncalibratedOD:  begin
  2763.                                     if x = 255.0 then
  2764.                                         x := 254.5;
  2765.                                     y := 0.434294481 * ln(255.0 / (255.0 - x))  {log10}
  2766.                                 end;
  2767.                             otherwise
  2768.                                 y := x;
  2769.                         end; {case}
  2770.                         cvalue[i] := y;
  2771.                         if y > maxCValue then
  2772.                             maxCValue := y;
  2773.                         if y < minCValue then
  2774.                             minCValue := y;
  2775.                     end; {for}
  2776.                 if minCValue >= 0.0 then
  2777.                     ZeroClip := false;
  2778.                 if ZeroClip then begin
  2779.                         for i := 0 to 255 do
  2780.                             if cvalue[i] < 0.0 then
  2781.                                 cvalue[i] := 0.0;
  2782.                         minCValue := 0.0;
  2783.                     end;
  2784.             end;
  2785.     end;
  2786.  
  2787.  
  2788.     procedure ScaleImageWindow (var trect: rect);
  2789.         var
  2790.             WindowLeft, WindowTop: integer;
  2791.             PicAspectRatio, TempMagnification: extended;
  2792.     begin
  2793.         with info^ do begin
  2794.                 SrcRect := PicRect;
  2795.                 with CGrafPtr(wptr)^.PortPixMap^^.bounds do begin
  2796.                         WindowLeft := -left;
  2797.                         WindowTop := -top;
  2798.                     end;
  2799.     with PicRect do
  2800.                     PicAspectRatio := right / bottom;
  2801.                 with trect do begin
  2802.                         if (WindowLeft + right) > (ScreenWidth - 5) then
  2803.                             right := ScreenWidth - 5 - WindowLeft;
  2804.                         bottom := round(right / PicAspectRatio);
  2805.                         if (WindowTop + bottom) > (ScreenHeight - 5) then
  2806.                             bottom := ScreenHeight - 5 - WindowTop;
  2807.                         right := round(bottom * PicAspectRatio);
  2808.                         magnification := right / PicRect.right;
  2809.                     end;
  2810.                 UpdateTitleBar;
  2811.             end; {with}
  2812.     end;
  2813.  
  2814.  
  2815.     function TooWide: boolean;
  2816.         var
  2817.             SelectionTooWide: boolean;
  2818.             MaxWidth: str255;
  2819.     begin
  2820.         with info^.RoiRect do
  2821.             SelectionTooWide := (right - left) > MaxLine;
  2822.         if SelectionTooWide then begin
  2823.                 NumToString(MaxLine, MaxWidth);
  2824.                 PutError(concat('This operation does not support selections wider than ', MaxWidth, ' pixels.'));
  2825.                 AbortMacro;
  2826.             end;
  2827.         TooWide := SelectionTooWide;
  2828.     end;
  2829.  
  2830.  
  2831.     procedure DrawTextString (str: str255; loc: point; just: integer);
  2832.         var
  2833.             SaveJust: integer;
  2834.     begin
  2835.         TextStr := str;
  2836.         IsInsertionPoint := true;
  2837.         TextStart := loc;
  2838.         SaveJust := TextJust;
  2839.         TextJust := just;
  2840.         DisplayText(false);
  2841.         TextJust := SaveJust;
  2842.         IsInsertionPoint := false;
  2843.     end;
  2844.  
  2845.  
  2846.     procedure IncrementCounter;
  2847.     begin
  2848.         if mCount < MaxMeasurements then begin
  2849.                 mCount := mCount + 1;
  2850.                 UnsavedResults := true;
  2851.             end
  2852.         else
  2853.             beep;
  2854.     end;
  2855.  
  2856.  
  2857.     procedure ClearResults (i: integer);
  2858.     begin
  2859.         mean^[i] := 0.0;
  2860.         sd^[i] := 0.0;
  2861.         PixelCount^[i] := 0;
  2862.         mArea^[i] := 0.0;
  2863.         mode^[i] := 0.0;
  2864.         IntegratedDensity^[i] := 0.0;
  2865.         idBackground^[i] := 0.0;
  2866.         xcenter^[i] := 0.0;
  2867.         ycenter^[i] := 0.0;
  2868.         MajorAxis^[i] := 0.0;
  2869.         MinorAxis^[i] := 0.0;
  2870.         orientation^[i] := 0.0;
  2871.         mMin^[i] := 0.0;
  2872.         mMax^[i] := 0.0;
  2873.         plength^[i] := 0.0;
  2874.     end;
  2875.  
  2876.     procedure UpdateFitEllipse;
  2877.     begin
  2878.         FitEllipse :=(xyLocM in measurements) or (MajorAxisM in measurements) or (MinorAxisM in measurements) or (AngleM in measurements);
  2879.     end;
  2880.  
  2881.  
  2882.  
  2883.     function StringToReal (str: str255): extended;
  2884.         var
  2885.             i, ndigits, StringLength: integer;
  2886.             c: char;
  2887.             n, m: extended;
  2888.             negative, LeftOfPoint, NegExp: boolean;
  2889.             exponent: LongInt;
  2890.     begin
  2891.         negative := false;
  2892.         n := 0.0;
  2893.         LeftOfPoint := true;
  2894.         m := 0.1;
  2895.         ndigits := 0;
  2896.         StringLength := length(str);
  2897.         i := 0;
  2898.         repeat
  2899.             i := i + 1;
  2900.         until (str[i] in ['0'..'9', '-', '.']) or (i >= StringLength);
  2901.         c := str[i];
  2902.         repeat
  2903.             if c = '-' then
  2904.                 negative := true
  2905.             else if c = '.' then
  2906.                 LeftOfPoint := false
  2907.             else if (c >= '0') and (c <= '9') then begin
  2908.                     ndigits := ndigits + 1;
  2909.                     if LeftOfPoint then
  2910.                         n := n * 10.0 + ord(c) - ord('0')
  2911.                     else begin
  2912.                             n := n + (ord(c) - ord('0')) * m;
  2913.                             m := m * 0.1;
  2914.                         end;
  2915.                 end;
  2916.             i := i + 1;
  2917.             if i <= StringLength then
  2918.                 c := str[i];
  2919.         until not (c in ['0'..'9', '-', '.']) or (i > StringLength);
  2920.         if (c = 'e') or (c = 'E') then begin
  2921.                 NegExp := false;
  2922.                 exponent := 0;
  2923.                 i := i + 1;
  2924.                 if i <= StringLength then
  2925.                     c := str[i];
  2926.                 if (c = '+') or (c = '-') then begin
  2927.                         if c = '-' then
  2928.                             NegExp := true;
  2929.                         i := i + 1;
  2930.                         if i <= StringLength then
  2931.                             c := str[i];
  2932.                     end;
  2933.                 repeat
  2934.                     if (c >= '0') and (c <= '9') then
  2935.                         exponent := exponent * 10 + ord(c) - ord('0');
  2936.                     i := i + 1;
  2937.                     if i <= StringLength then
  2938.                         c := str[i];
  2939.                 until not (c in ['0'..'9']) or (i > StringLength);
  2940.                 if negExp then
  2941.                     exponent := -exponent;
  2942.                 if exponent <> 0 then
  2943.                     n := n * exp(exponent * ln(10));
  2944.             end; {if c='e'}
  2945.         if ndigits = 0 then
  2946.             n := BadReal
  2947.         else if negative then
  2948.             n := -n;
  2949.         StringToReal := n;
  2950.     end;
  2951.  
  2952.  
  2953.     procedure RemovePath(var str: str255);
  2954.     var
  2955.         loc: integer;
  2956.     begin
  2957.         repeat
  2958.             loc := pos(':', str);
  2959.             if loc > 0 then
  2960.                 delete(str, 1, loc);
  2961.         until loc = 0;
  2962.     end;
  2963.  
  2964.  
  2965.     procedure MakeNewWindow (name: str255);
  2966.         var
  2967.             wwidth, wheight, wleft, wtop, i: integer;
  2968.             tPort: GrafPtr;
  2969.             rgb: RGBColor;
  2970.             err: OSErr;
  2971.             str: str255;
  2972.             SaveGDevice: GDHandle;
  2973.     begin
  2974.         with Info^ do begin
  2975.                 RemovePath(name);
  2976.                 wleft := PicLeft;
  2977.                 wtop := PicTop;
  2978.                 PicLeft := PicLeft + hPicOffset;
  2979.                 PicTop := PicTop + vPicOffset;
  2980.                 if ((PicLeft + round(0.75 * PixelsPerLine)) > ScreenWidth) or ((PicTop + round(0.75 * nlines)) > ScreenHeight) then begin
  2981.                         PicLeft := PicLeftBase;
  2982.                         PicTop := PicTopBase;
  2983.                     end;
  2984.                 wwidth := PixelsPerLine;
  2985.                 if (wleft + wwidth) > ScreenWidth then
  2986.                     wwidth := ScreenWidth - wleft - 4;
  2987.                 wheight := nlines;
  2988.                 if (wtop + wheight) > ScreenHeight then
  2989.                     wheight := ScreenHeight - wtop - 4;
  2990.                 if OpeningPlugInWindow then
  2991.                     SetRect(wrect, -10000, wtop, -10000 + wwidth, wtop + wheight)
  2992.                 else
  2993.                     SetRect(wrect, wleft, wtop, wleft + wwidth, wtop + wheight);
  2994.                 str := name;
  2995.                 if SpatiallyCalibrated then
  2996.                     str := concat(str, chr($13)); {Black Diamond}
  2997.                 if fit <> uncalibrated then
  2998.                     str := concat(str, '◊');
  2999.                 wptr := NewCWindow(nil, wrect, str, true, DocumentProc + ZoomDocProc, nil, true, 0);
  3000.                 GetPort(tPort);
  3001.                 SetPort(wptr);
  3002.                 SetPalette(wptr, ExplicitPalette, false);
  3003.                 pmForeColor(BlackIndex);
  3004.                 pmBackColor(WhiteIndex);
  3005.                 SetRect(wrect, 0, 0, wwidth, wheight);
  3006.                 SetRect(PicRect, 0, 0, PixelsPerLine, nlines);
  3007.                 SelectWindow(wptr);
  3008.                 WindowPeek(wptr)^.WindowKind := PicKind;
  3009.                 WindowPeek(wptr)^.RefCon := ord4(Info);
  3010.                 TruncateString(name, maxTitle);
  3011.                 title := name;
  3012.                 ExtendWindowsMenu(name, PixMapSize, wptr);
  3013.                 PicNum := nPics;
  3014.                 PidNum := nextPid;
  3015.                 nextPid := nextPid - 1;
  3016.                 osPort := CGrafPtr(NewPtr(SizeOf(CGrafPort)));
  3017.                 SaveGDevice := GetGDevice;
  3018.                 SetGDevice(osGDevice);
  3019.                 OpenCPort(osPort);
  3020.                 with osPort^ do begin
  3021.                         with PortPixMap^^ do begin
  3022.                                 BaseAddr := PicBaseAddr;
  3023.                                 bounds := PicRect;
  3024.                                 pixelType := 0;
  3025.                                 if PixelSize > 8 then
  3026.                                     PixelSize := 8;
  3027.                                 cmpCount := 1;
  3028.                             end;
  3029.                         PortRect := PicRect;
  3030.                         RectRgn(visRgn, PicRect);
  3031.                         PortPixMap^^.RowBytes := BitOr(BytesPerRow, $8000);
  3032.                     end;
  3033.                 SetPalette(WindowPtr(osPort), ExplicitPalette, false);
  3034.                 pmForeColor(ForegroundIndex);
  3035.                 pmBackColor(BackgroundIndex);
  3036.                 SetGDevice(SaveGDevice);
  3037.                 SetPort(tPort);
  3038.                 SrcRect := wrect;
  3039.                 magnification := 1.0;
  3040.                 RoiShowing := false;
  3041.                 roiType := NoRoi;
  3042.                 initwrect := wrect;
  3043.                 savewrect := wrect;
  3044.                 SaveSrcRect := SrcRect;
  3045.                 SaveMagnification := magnification;
  3046.                 savehloc := wleft;
  3047.                 savevloc := wtop;
  3048.                 roiRgn := NewRgn;
  3049.                 NewPic := true;
  3050.                 ScaleToFitWindow := false;
  3051.                 OpPending := false;
  3052.                 Changes := false;
  3053.                 WindowState := NormalWindow;
  3054.                 if (fit = uncalibrated) and InvertPixelValues then
  3055.                     InvertGrayLevels;
  3056.                 Revertable := false;
  3057.             end;
  3058.         WhatToUndo := NothingToUndo;
  3059.     end;
  3060.  
  3061.  
  3062.     procedure MakeLowerCase (var str: str255);
  3063.         var
  3064.             i: integer;
  3065.             c: char;
  3066.     begin
  3067.         for i := 1 to length(str) do begin
  3068.                 c := str[i];
  3069.                 if (c >= 'A') and (c <= 'Z') then
  3070.                     str[i] := chr(ord(c) + 32);
  3071.             end;
  3072.     end;
  3073.  
  3074.  
  3075.     function PutMessageWithCancel (str: str255): integer;
  3076.     begin
  3077.         InitCursor;
  3078.         ParamText(str, '', '', '');
  3079.         PutMessageWithCancel := Alert(800, nil);
  3080.     end;
  3081.  
  3082.  
  3083.     function CurrentWindow: integer;
  3084.     begin
  3085.         CurrentWPtr := FrontWindow;
  3086.         if CurrentWPtr <> nil then begin
  3087.                 CurrentKind := WindowPeek(CurrentWPtr)^.WindowKind;
  3088.                 if CurrentKind = TextKind then
  3089.                     TextInfo := TextInfoPtr(WindowPeek(CurrentWPtr)^.RefCon);
  3090.                 CurrentWindow := CurrentKind;
  3091.             end
  3092.         else begin
  3093.                 CurrentWindow := 0;
  3094.                 CurrentKind := 0;
  3095.             end;
  3096.     end;
  3097.  
  3098.  
  3099.     procedure FindMonitors (NewScreenDepth: integer);
  3100.   {Generate a list of 8-bit monitors so we can update their LUTs.}
  3101.   {This wouldn't be necessary if we were using the Palette Manager.}
  3102.         var
  3103.             nextDevice: GDHandle;
  3104.     begin
  3105.         nMonitors := 0;
  3106.         nextDevice := GetDeviceList;
  3107.         while nextDevice <> nil do begin
  3108.                 if TestDeviceAttribute(nextDevice, screenDevice) and TestDeviceAttribute(nextDevice, screenActive) then
  3109.                     if nextDevice^^.gdPmap^^.PixelSize = 8 then begin
  3110.                             nMonitors := nMonitors + 1;
  3111.                             Monitors[nMonitors] := nextDevice;
  3112.                         end;
  3113.                 nextDevice := GetNextDevice(nextDevice);
  3114.             end; {while}
  3115.         if NewScreenDepth < 4 then
  3116.             gCopyMode := DitherCopy
  3117.         else
  3118.             gCopyMode := SrcCopy;
  3119.         SaveScreenDepth := NewScreenDepth;
  3120.     end;
  3121.  
  3122.  
  3123.     function ScreenDepth: integer;
  3124.         var
  3125.             depth: integer;
  3126.     begin
  3127.         depth := ScreenPixMap^^.PixelSize;
  3128.         if depth <> SaveScreenDepth then
  3129.             FindMonitors(depth);
  3130.         ScreenDepth := depth;
  3131.     end;
  3132.  
  3133.  
  3134.     procedure SetFColor (index: integer);
  3135.   {Sets the screen foreground color. Use pmForeColor to set the offscreen color.}
  3136.     begin
  3137.         if ScreenDepth = 8 then
  3138.             pmForeColor(index)
  3139.         else
  3140.             RGBForeColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
  3141.     end;
  3142.  
  3143.     procedure SetBColor (index: integer);
  3144.   {Sets the screen background color.}
  3145.     begin
  3146.         if ScreenDepth = 8 then
  3147.             pmBackColor(index)
  3148.         else
  3149.             RGBBackColor(osGDevice^^.gdPMap^^.pmTable^^.ctTable[index].rgb);
  3150.     end;
  3151.     
  3152.     
  3153.     function DoubleToReal(d:FakeDouble):extended;
  3154.     {Converts an IEEE double to an IEEE float. Will not be needed
  3155.     when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
  3156.     var
  3157.       s, f, r:extended;
  3158.       e:LongInt;
  3159.       dd:double;
  3160.     begin
  3161.         {$ifc PowerPC}
  3162.         dd:=double(d);
  3163.         r:=dd;
  3164.         {$elsec PowerPC}
  3165.         if band(d[1],$80000000)=0 then
  3166.             s:=1
  3167.         else
  3168.             s:=-1;
  3169.         e:=band(d[1],$7ff00000);
  3170.         e:=bsr(e,20);
  3171.         f:=band(d[1],$fffff);
  3172.         f:=f / 1048576.0;
  3173.         f:=f + bsr(d[2],24)/268435456.0;
  3174.         {ShowMessage(StringOf('s=',s , ' e=', e, ' f=', f));}
  3175.         if (e > 0) and (e < 2047) then 
  3176.             r:=s * exp((e-1023)*ln(2.0)) * (1.0 + f)
  3177.         else if (e = 0) and (f <> 0) then 
  3178.             r:=s * f * exp(-1022.0*ln(2.0)) * f
  3179.         else if (e = 0) and (e = 0) then
  3180.             r:=0.0
  3181.         else if (e = 255) and (f = 0) then
  3182.             r:=0.0 {inf}
  3183.         else {if e=255 and f<>0}
  3184.             r:=0.0; {nan}
  3185.         {$endc PowerPC}
  3186.         DoubleToReal:=r;
  3187.     end;
  3188.  
  3189.  
  3190.     procedure RealToDouble(rr: extended; var d:FakeDouble);
  3191.     {Converts an IEEE float to an IEEE double. Will not be needed
  3192.     when "8 Byte Doubles" work in the Metrowerks 68k compiler.}
  3193.     var
  3194.       i, s, e, f:LongInt;
  3195.       r:real;
  3196.       dd:double;
  3197.     begin
  3198.         {$ifc PowerPC}
  3199.         dd:=rr;
  3200.         d:=FakeDouble(dd);
  3201.         {$elsec PowerPC}
  3202.         r:=rr;
  3203.         i:=LongInt(r);
  3204.       s:=band(i,$80000000);
  3205.       e:=band(i,$7f800000);
  3206.         e:=bsr(e, 23);
  3207.         if e>255 then
  3208.             e:=255;
  3209.         e:=e-127+1023;
  3210.         e:=bsl(e, 20);
  3211.         f:=band(i, $7fffff);
  3212.         f:=bsr(f, 3);
  3213.         d[1]:=bor(s,bor(e,f));
  3214.         d[2]:=0;
  3215.         {if r<>0.0 then begin
  3216.             ShowMessage(StringOf(' e=', e,' f=', f)); wait(60);
  3217.         end;}
  3218.         {$endc PowerPC}
  3219.     end;
  3220.     
  3221.     
  3222. {$S Utilities2}
  3223. {Routines from here to the end of the file go in the Utilities2 segment}
  3224.  
  3225.     function MakeStackFromWindow: boolean;
  3226.     begin
  3227.         with info^ do begin
  3228.                 StackInfo := StackInfoPtr(NewPtr(SizeOf(StackInfoRec)));
  3229.                 if StackInfo = nil then begin
  3230.                         MakeStackFromWindow := false;
  3231.                         exit(MakeStackFromWindow);
  3232.                     end;
  3233.                 with StackInfo^ do begin
  3234.                         nSlices := 1;
  3235.                         CurrentSlice := 1;
  3236.                         PicBaseH[1] := PicBaseHandle;
  3237.                         SliceSpacing := 0.0;
  3238.                         FrameInterval := 0.0;
  3239.                         StackType := VolumeStack;
  3240.                     end;
  3241.                 PictureType := NewPicture;
  3242.                 MakeStackFromWindow := true;
  3243.             end;
  3244.     end;
  3245.  
  3246.     
  3247.     procedure SelectSlice (i: integer);
  3248.     begin
  3249.         with info^, info^.StackInfo^ do
  3250.             if i <= nSlices then begin
  3251.                     hunlock(PicBaseHandle);
  3252.                     PicBaseHandle := PicBaseH[i];
  3253.                     hlock(PicBaseHandle);
  3254.                     {$ifc PowerPC}
  3255.                     PicBaseAddr := PicBaseHandle^;
  3256.                     {$elsec}
  3257.                     PicBaseAddr := StripAddress(PicBaseHandle^);
  3258.                     {$endc}
  3259.                     osPort^.PortPixMap^^.BaseAddr := PicBaseAddr;
  3260.                 end;
  3261.     end;
  3262.  
  3263.  
  3264.     procedure UpdateWindowsMenuItem;
  3265.         var
  3266.             str: str255;
  3267.             picSize: LongInt;
  3268.     begin
  3269.         with info^ do begin
  3270.             PicSize := PixMapSize;
  3271.             if StackInfo <> nil then
  3272.                 PicSize := PicSize * StackInfo^.nSlices;
  3273.             if DataH <> nil then
  3274.                 PicSize := PicSize + PicSize * SizeOf(real);
  3275.             NumToString((PicSize + 511) div 1024, str);
  3276.             str := concat(title, '  ', str, 'K');
  3277.             SetMenuItemText(WindowsMenuH, PicNum + WindowsMenuItems + nTextWindows, str);
  3278.         end;
  3279.     end;
  3280.  
  3281.  
  3282.     function AddSlice (update: boolean): boolean;
  3283.         var
  3284.             i: integer;
  3285.             h: handle;
  3286.             isRoi: boolean;
  3287.     begin
  3288.         with info^, info^.StackInfo^ do begin
  3289.                 AddSlice := false;
  3290.                 if nSlices = MaxSlices then
  3291.                     exit(AddSlice);
  3292.                 isRoi := RoiShowing;
  3293.                 if isRoi then
  3294.                     KillRoi;
  3295.                 h := GetBigHandle(PixMapSize);
  3296.                 if h = nil then begin
  3297.                         PutError('Not enough memory available to add a slice to this stack.');
  3298.                         AbortMacro;
  3299.                         exit(AddSlice);
  3300.                     end;
  3301.                 for i := nSlices downto CurrentSlice + 1 do
  3302.                     PicBaseH[i + 1] := PicBaseH[i];
  3303.                 nSlices := nSlices + 1;
  3304.                 CurrentSlice := CurrentSlice + 1;
  3305.                 PicBaseH[CurrentSlice] := h;
  3306.                 SelectSlice(CurrentSlice);
  3307.                 if Update then begin
  3308.                         SelectAll(false);
  3309.                         DoOperation(EraseOp);
  3310.                         UpdatePicWindow;
  3311.                     end;
  3312.                 if (StackType = rgbStack) and (nSlices <> 3) then
  3313.                     StackType := VolumeStack;
  3314.                 UpdateTitleBar;
  3315.                 if isRoi then
  3316.                     RestoreRoi;
  3317.                 WhatToUndo := NothingToUndo;
  3318.                 AddSlice := true;
  3319.                 changes := true;
  3320.                 PictureType := NewPicture;
  3321.                 UpdateWindowsMenuItem;
  3322.             end;
  3323.     end;
  3324.     
  3325.     
  3326.     procedure AbortMacro;
  3327.     {If a macro is running, abort it.}
  3328.     begin
  3329.         macro := false;
  3330.     end;
  3331.     
  3332.     
  3333.     procedure TruncateString(var str: str255; len: integer);
  3334.     begin
  3335. {if length(str) > len then
  3336.     beep;}
  3337.             if length(str) > len then
  3338.             delete(str, len + 1, length(str) - len);
  3339.     end;
  3340.     
  3341.             
  3342.     procedure CloseVdig;
  3343.     {Closes the current video digitizer component and
  3344.     its associated offscreen graphics world.}
  3345.     var
  3346.         err: osErr;
  3347.     begin
  3348.         if fgPixMap <> nil then begin
  3349.             DisposeGWorld(osGWorld);
  3350.             osGWorld := nil;
  3351.             GWorldLUT := nil;
  3352.             fgPixMap := nil;
  3353.         end;
  3354.         if vdig <> nil then begin
  3355.             err := CloseComponent(vdig);
  3356.             vdig := nil;
  3357.         end;
  3358.         FrameGrabber := noFrameGrabber;
  3359.     end;
  3360.  
  3361.  
  3362. end.